PDA

Vollständige Version anzeigen : Makro gesucht!


__Lukas__
21.04.2009, 07:28
Hallo zusammen

Für meine Diplomarbeit habe ich ein kleines Problem, welches aber für einen VBA-Fortgeschrittenen kein Problem sein dürfte. Das Makro soll einfach bei jedem Datenbereich aller Diagramme der ganzen Arbeitsmappe Zeilen subtrahieren und dazuzählen. Dies sieht dann so aus:

Ich habe insgesamt etwa 70 Diagramme auf dem Tabellenblatt Gesamtübersich_Projekte. Jetzt möchte ich ein Makro, welches mir bei jedem Diagramm den Datenbereich folgendermassen anpasst:
z.B soll er aus dem Datenbereich =Gesamtübersicht_Projekte!$AA$2:$AJ$19 16 Zeilen subtrahieren, was dann diesen Bereich ergibt: =Gesamtübersicht_Projekte!$AA$2:$AJ$3. danach soll er jeweils den Wert aus G4 dazuzählen.

Beispiel:
Das sieht dann folgendermassen aus für G4 =3:
Diagramm 1:
Datenbereich: =Gesamtübersicht_Projekte!$AA$2:$AJ$19
jetzt soll das Makro 16 Zeilen subtrahieren, was dann daraus =Gesamtübersicht_Projekte!$AA$2:$AJ$3 macht. Schlussendlich soll dann der Wert von G4 als Zeilen noch dazugezählt werden, was dann =Gesamtübersicht_Projekte!$AA$2:$AJ$6 macht.

Könnte mir jemand dieses Makro programmieren? Ich wäre sehr dankbar, denn dann wäre ich endlich am Ziel meiner Diplomarbeit..:)

Achtung: der fette Bereich kann auch variiren: =!<b>Gesamtübersicht_Projekte$AA$2:$AJ</b>$3
Man kann es vielleicht so einschränken, dass das Makro erst nach dem Letzten Dollarzeichen in der Formel die Änderungen vornimmt.

Zusammenfassung Makro:
Das Makro sollte zusammengefasst also nur bei jedem Diagramm auf dem Arbeitsblatt Gesamtübersicht_Projekte beim aktuellen Datenbereich nach dem letzten Dollarzeichen 16 (Zeilen) subtrahieren und den aktuellen Wert von G4 addieren.

Vielen Dank für deine/eure Hilfe!
Gruss Lukas

jinx
21.04.2009, 08:25
Moin, Lukas,

versuch es mal mit diesem Code:

Sub ChartsAnpassen()

Dim oChrt As ChartObject
Dim szSeries As String
Dim lngRow As Long

On Error GoTo ErrExit
Application.EnableEvents = False

Set oChrt = ActiveSheet.ChartObjects(1)

If Not oChrt Is Nothing Then
For Each oChrt In ActiveSheet.ChartObjects
szSeries = oChrt.Chart.SeriesCollection(1).Formula
szSeries = Left(szSeries, InStrRev(szSeries, ",") - 1)
szSeries = Right(szSeries, (Len(szSeries) - InStrRev(szSeries, ",")))
lngRow = Right(szSeries, (Len(szSeries) - InStrRev(szSeries, "$"))) - 16 + Range("G4").Value
szSeries = Replace(szSeries, Right(szSeries, (Len(szSeries) - InStrRev(szSeries, "$"))), lngRow)
oChrt.Chart.SetSourceData Source:=Range(szSeries)
Next oChrt
End If

Set oChrt = Nothing

ErrExit:
Application.EnableEvents = True

End Sub

__Lukas__
21.04.2009, 08:41
Hallo jinx

Erstmals vielen Dank für deine Antwort.
Das Makro funktioniert leider nicht ganz so wie ich es mir vorgestellt habe.
Kleines vereinfachtes Beispiel:
__A__B__C__D__E__F__G
a_23
b
c
d

wenn das die Tabelle ist, welche ich brauche nimmt mir das MAkro jeweils für den Datenbereich immer nur die Zelle mit der Zahl 23 (nennen wir diese Zelle B2) an stelle des ganzen bereichs A1:G5). Weisst du diesen Fehler zu beheben?

Vielen Dank für deine Hilfe!
Gruss Lukas

__Lukas__
21.04.2009, 08:50
was ich no vergessen habe zu sagen:
Mein obiges Beispiel ist für G4=1
dann sollte natürlich nur der Bereich A1:G2 wiedergeben werden und nicht A1:G5

Gruss

jinx
21.04.2009, 09:18
Moin, Lukas,

Gesamtübersicht_Projekte!$AA$2:$AJ$19
A1:G2
erklärst Du mir bitte, wie man vom zweiten Wert 16 abzieht, den Wert von G4 (angegeben war 3) addiert und eine positive Zahl an Zeilen zur Vermeidung eines Laufzeitfehlers bekommt (ich erhalte dort als Ergebnis der ersten Fragestellung -13, und eine Zelle G-13 gibt es in Excel nicht)?

__Lukas__
21.04.2009, 09:29
Hallo nocheinmal:)
Hier ein Ausschnitt der Datei:
http://www.fileuploadx.de/591457

hoffe du kannst mir so weiterhelfen.
Die Diagramme sollen so angepasst werden, dass man in G4 eine Zahl eingeben kann, welche einem Monat enspricht, und die Datenbereiche sich dan denen anpassen. Also eine Art dynamische Diagramm werden.

Gruss Lukas und Danke für deine Hilfe!

__Lukas__
21.04.2009, 09:31
http://www.fileuploadx.de/998418

jinx
21.04.2009, 09:47
Moin, Lukas,

auch beim zweiten Link erhalte ich nach 35 Sekunden Wartezeit den Hinweis Invalid Link.

yEEEah
21.04.2009, 09:55
so habe mich jetzt angemeldet..
Denke werde dies auch nicht bereuen:)
Hänge dir die Datei hier an, da sie für den Forum-Server zu gross ist:
http://rapidshare.com/files/223915712/Test.xls.html

Gruss

jinx
21.04.2009, 11:14
Moin, Lukas,

die Lösung ist für mich leider nicht so einfach, wie sie im ersten Beitrag erfragt wurde (die Bereiche der Diagramme sind unterschiedlich, und zur Zeit habe ich keine Idee, wie ich den ermittelten Zeilenwert für das Datum in die Diagrammquelle einfügen kann). Mal sehen, ob mich heute Nachmittag ein "Lichtblick" bezüglich der Lösung "befällt"...

yEEEah
21.04.2009, 11:31
Hallo jinx

Vielen Dank, das du dir so viel Mühe gibst!
Einen Vorschlag hätte ich ja, aber ich weiss nicht wie ich das in VBA umsetzen muss, da mir das Wissen fehlt. Der Vorschlag ist folgender:

Nehmen wir z.B den Bereich =Gesamtübersicht_Projekte!$AA$43:$AJ$60 mit G4=5
ich würde das in zwei Makros aufteilen, ein Makro, welches nur einmal ausgeführt wird, sagen wir dem Makro1 und ein Makro, welches die Diagramme immer wieder ändert, je nach Wert in G4.

Zu Makro 1:
Makro1 soll bei jedem Diagramm im Datenbereich am Schluss (nach dem letzten Dollarzeichen) 16 Zeilen subtrahieren, sprich aus unserem Beispiel =Gesamtübersicht_Projekte!$AA$43:$AJ$60 wird dann =Gesamtübersicht_Projekte!$AA$43:$AJ$44

Dieses Makro wird genau einmal benutzt und dann ist es nutzlos, da nur einmal 16 Zeilen subtrahiert werden müssen.


Jetzt zu Makro 2:
Makro 2 soll dann immer am Schluss des Datenbereichs noch den Wert aus G4 addieren (in unserem Falle den Wert 5). Dies macht dann aus unserem bereits von Makro1 bearbeiteten Datenbereich =Gesamtübersicht_Projekte!$AA$43:$AJ$44 den Datenbereich =Gesamtübersicht_Projekte!$AA$43:$AJ$49.


=Gesamtübersicht_Projekte!$AA$43:$AJ$49 besteht aus =Gesamtübersicht_Projekte!$AA$43:$AJ$44 + am Schluss noch den Wert aus G4.

Ich hoffe das dies irgendwie mit einem Makro zu realisieren ist. Für deine Hilfe bin ich dir schon mal riesig dankbar!

Gruss Lukas

jinx
21.04.2009, 14:44
Moin, Lukas,

das klitzekleine Problem an der ganzen Sache ist nur, dass =Gesamtübersicht_Projekte!$AA$43:$AJ$60 zwar per SetCourceData zugewiesen werden kann, aber meines Wissens nirgends in dieser Art zur Verfügung gestellt wird.

Vielleicht liest Du Dir einmal Change Series Formulas (http://peltiertech.com/Excel/Charts/ChgSrsFmla.html) durch - ich werde mal versuchen, den Code auf Deine Gegebenheiten anzupassen.

Erweiterung: Bei Karin/Beverly kann man unter Datenbereich auslesen (http://c.excelhost.de/c_beverly/getfile.php?id=35) eine Beispielmappe finden, die auch den Weg des Auslesens der SeriesCollection geht.

jinx
21.04.2009, 15:35
Moin, Lukas,

bitte an einer Kopie der Mappe ausprobieren, sowohl die Sub als auch die Funktion gehören in ein allgemeines Modul:

Sub DiagrammFormelnÄndern()

Dim objChart As ChartObject
Dim objCG As ChartGroup
Dim objChrtSeries As Series
Dim varArray As Variant
Dim lngCounter As Long
Dim strItem As String
Dim lngNewRow As Long
Dim strOldRow As String
Dim lngArray As Long

For Each objChart In ActiveSheet.ChartObjects
For Each objCG In objChart.Chart.ChartGroups
For Each objChrtSeries In objCG.SeriesCollection
If fncSeriesFormula(objChrtSeries) Then
strItem = objChrtSeries.Formula
varArray = Split(strItem, ",")
lngArray = 1
Do While IsNumeric(Mid(varArray(1), Len(varArray(1)) - lngArray, 1))
lngArray = lngArray + 1
Loop
lngNewRow = Right(varArray(1), lngArray)
lngNewRow = lngNewRow - 16 + Application.Match(CDbl(DateSerial(Range("B4").Value, Range("G4").Value, 1)), Columns(27), 0) - 2
For lngCounter = 1 To 2
varArray(lngCounter) = Replace(varArray(lngCounter), Right(varArray(lngCounter), (Len(varArray(lngCounter)) - InStrRev(varArray(lngCounter), "$"))), lngNewRow)
Next lngCounter
strItem = Join(varArray, ",")
Debug.Print strItem
objChrtSeries.Formula = strItem
End If
Next objChrtSeries
Next objCG
Next objChart

End Sub

Private Function fncSeriesFormula(strSeries) As Boolean

On Error Resume Next
Debug.Print strSeries.Formula
fncSeriesFormula = (Err = 0)

End Function
Die Vergleichsangabe der Zeile wird aus den Angaben des Jahres (Zelle B4 und des Monats G4 mit dem ersten Tag des Monats hergestellt) und sollte ggf. noch irgendwo gepeichert werden. Alternativ können die Zeilenzahlen über eine Select Case-Anweisung in Bereiche aufgeteilt werden und dann auf den jeweiligen Startwert zurückgestellt werden...

yEEEah
22.04.2009, 05:24
Hallo jinx
Also erstmal, vielen Dank für alles! Es funktioniert genau so, wie ich es mir vorgestellt habe. Einfach nur super!

Nur habe ich deine Anweisung am schluss nicht verstanden:

Die Vergleichsangabe der Zeile wird aus den Angaben des Jahres (Zelle B4 und des Monats G4 mit dem ersten Tag des Monats hergestellt) und sollte ggf. noch irgendwo gepeichert werden. Alternativ können die Zeilenzahlen über eine Select Case-Anweisung in Bereiche aufgeteilt werden und dann auf den jeweiligen Startwert zurückgestellt werden...

was habe ich da genau zu machen? Ich besitze leider nur Grundkenntnisse in VBA und deswegen habe ich da so meine Mühe..:)

Aber nochmals Vielen Dank!

jinx
22.04.2009, 06:42
Moin, Lukas,

Du solltest doch die Mappe kennen, oder? Sieht das wie eine Zahl aus, auf die man sich so einfach beziehen kann? Die Monatszahl 3 für März kommt immerhin dreimal im Bereich vor - welches Schweinderl nehmen´s denn dann, wenn kein Jahr mit dabei ist? Das aktuelle - aber ob das wirklich gewünscht wurde - diese Anpassung fehlt hier für den Fall, dass B4 leer ist...

<b>Gesamtübersicht_Projekte</b><br /><br /><table border="1" cellspacing="0" cellpadding="0" style="font-family:Arial,Arial; font-size:10pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:55px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td >&nbsp;</td><td >AA</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="background-color:#ffff00; text-align:right; ">Jan 08</td></tr><tr style="height:21px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="background-color:#ffff00; text-align:right; ">Feb 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="background-color:#ffff00; text-align:right; ">Mrz 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="background-color:#ffff00; text-align:right; ">Apr 08</td></tr><tr style="height:24px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="background-color:#ffff00; text-align:right; ">Mai 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td style="background-color:#ffff00; text-align:right; ">Jun 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td style="background-color:#ffff00; text-align:right; ">Jul 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td style="background-color:#ffff00; text-align:right; ">Aug 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td style="background-color:#ffff00; text-align:right; ">Sep 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td style="background-color:#ffff00; text-align:right; ">Okt 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >13</td><td style="background-color:#ffff00; text-align:right; ">Nov 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >14</td><td style="background-color:#ffff00; text-align:right; ">Dez 08</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >15</td><td style="background-color:#ffff00; text-align:right; ">Jan 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >16</td><td style="background-color:#ffff00; text-align:right; ">Feb 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >17</td><td style="background-color:#ffff00; text-align:right; ">Mrz 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >18</td><td style="background-color:#ffff00; text-align:right; ">Apr 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >19</td><td style="background-color:#ffff00; text-align:right; ">Mai 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >20</td><td style="background-color:#ffff00; text-align:right; ">Jun 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >21</td><td style="background-color:#ffff00; text-align:right; ">Jul 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >22</td><td style="background-color:#ffff00; text-align:right; ">Aug 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >23</td><td style="background-color:#ffff00; text-align:right; ">Sep 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >24</td><td style="background-color:#ffff00; text-align:right; ">Okt 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >25</td><td style="background-color:#ffff00; text-align:right; ">Nov 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >26</td><td style="background-color:#ffff00; text-align:right; ">Dez 09</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >27</td><td style="background-color:#ffff00; text-align:right; ">Jan 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >28</td><td style="background-color:#ffff00; text-align:right; ">Feb 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >29</td><td style="background-color:#ffff00; text-align:right; ">Mrz 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >30</td><td style="background-color:#ffff00; text-align:right; ">Apr 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >31</td><td style="background-color:#ffff00; text-align:right; ">Mai 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >32</td><td style="background-color:#ffff00; text-align:right; ">Jun 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >33</td><td style="background-color:#ffff00; text-align:right; ">Jul 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >34</td><td style="background-color:#ffff00; text-align:right; ">Aug 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >35</td><td style="background-color:#ffff00; text-align:right; ">Sep 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >36</td><td style="background-color:#ffff00; text-align:right; ">Okt 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >37</td><td style="background-color:#ffff00; text-align:right; ">Nov 10</td></tr><tr style="height:17px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >38</td><td style="background-color:#ffff00; text-align:right; ">Dez 10</td></tr></table> <br />
Anpassung im Makrocode:

Sub DiagrammFormelnÄndern2()

Dim objChart As ChartObject
Dim objCG As ChartGroup
Dim objChrtSeries As Series
Dim varArray As Variant
Dim lngCounter As Long
Dim strItem As String
Dim lngNewRow As Long
Dim strOldRow As String
Dim lngArray As Long

For Each objChart In ActiveSheet.ChartObjects
For Each objCG In objChart.Chart.ChartGroups
For Each objChrtSeries In objCG.SeriesCollection
If fncSeriesFormula(objChrtSeries) Then
strItem = objChrtSeries.Formula
varArray = Split(strItem, ",")
lngArray = 1
Do While IsNumeric(Mid(varArray(1), Len(varArray(1)) - lngArray, 1))
lngArray = lngArray + 1
Loop
lngNewRow = Right(varArray(1), lngArray)
Select Case lngNewRow
Case 3 To 38
lngNewRow = 3
Case 44 To 79
lngNewRow = 44
Case 85 To 120
lngNewRow = 85
Case Else
MsgBox "Wert nicht vorgesehen"
Exit Sub
End Select
lngNewRow = lngNewRow + Application.Match(CDbl(DateSerial(Range("B4").Value, Range("G4").Value, 1)), Columns(27), 0) - 2
For lngCounter = 1 To 2
varArray(lngCounter) = Left(varArray(lngCounter), Len(varArray(lngCounter)) - lngArray) & lngNewRow
Next lngCounter
strItem = Join(varArray, ",")
' Debug.Print strItem
objChrtSeries.Formula = strItem
End If
Next objChrtSeries
Next objCG
Next objChart

End Sub

yEEEah
22.04.2009, 06:57
Hallo jinx
Das B4 das Jahr und G4 der Monat ist, ist/war mir schon klar:) Ich kapier das mit dem zurücksetzen nicht ganz.
Wenn ich etwa 5 Mal die Zahl in B4 ändere, manchmanl auch das Jahr, dann geht auf einmal nichts mehr. Wieso das?

Vielen Dank für deine Mühe!
Gruss Lukas

jinx
22.04.2009, 07:02
Moin, Lukas,

welchen Code setzt Du dann ein? Ich vermute mal, nicht den letzten...

yEEEah
22.04.2009, 07:10
jetzt schon..:) Man bin ich hohl..
Klappt alles..!:)
Falls noch weitere Probleme auftauchen sollten, hoffe ich einfach, dass ich mich hier wieder melden darf, trotz den Umständen:)

Vielen Dank für deine beanspruchte Zeit Jinx!
Hast mir sehr weitergeholfe!

Gruss Lukas