Hallo,
ich möchte aus einer Tabelle mit Zellenprogrammierung durch ein makro eine neue Gesamttabelle erstellen um die grafisch auswerten zu können.
In meiner ursprünglichen Tabelle gibt es eine zeile über einen bestimmten Zeitraum, die immer einen Monat weiterläuft. Jedem dieser Monate ist ein bestimmter Wert zugeordnet.
Daraus möchte ich eine Tabelle über den gesamten Zeitraum vom kleinsten Datum bis zum größten erstellen, in dem die Werte den Daten zugeordnet werden und bei den Daten zu den es bei einer Zeitraum keinen Wert gibt, da das Datum vor oder nach dem Zeitraum liegt, soll diesem eine Datum dann eine Null zugeordnet werden. Dazu habe ich folgenden Code geschrieben, der mir Leider nur die Überschriften der wertereihen und 4-Zellen mit Daten ausgibt.
Hab ich einen Denkfehler in der Programmierung?
Sub Tabelle()
Dim i, j, k, z As Integer
Dim iZeile, iSpalte As Integer
Dim iIst, igesamt, iDatDiff As Integer
Dim klDatum, grDatum As Date
klDatum = Worksheets(sTbl3).Cells(25, 4).Value
grDatum = Worksheets(sTbl3).Cells(25, 4).Value
With Worksheets(sTbl4)
' Neuer Diagrammbereich
For i = 25 To Worksheets(sTbl3).Range("BC25")
.Range("C1").Select
iZeile = .Range("C2")
iSpalte = 3
For j = 25 To Worksheets(sTbl3).Range("B105").End(xlUp).Row + 2
Select Case i
Case 25:
.Cells(iZeile, iSpalte).NumberFormat = "MMM YY"
.Cells(iZeile, iSpalte).Value = Worksheets(sTbl3).Cells(j, i).Value
' Das Anfangs- sowie Enddatum ermitteln
If Worksheets(sTbl3).Cells(j, i).Value < klDatum Then klDatum = Worksheets(sTbl3).Cells(j, i).Value
If Worksheets(sTbl3).Cells(j, i).Value > grDatum Then grDatum = Worksheets(sTbl3).Cells(j, i).Value
Case Else:
.Cells(iZeile, iSpalte).NumberFormat = "MMM YY"
.Cells(iZeile, iSpalte).Value = Worksheets(sTbl3).Cells(j, i).Value - 1
If Worksheets(sTbl3).Cells(j, i).Value < klDatum Then klDatum = Worksheets(sTbl3).Cells(j, i).Value
If Worksheets(sTbl3).Cells(j, i).Value > grDatum Then grDatum = Worksheets(sTbl3).Cells(j, i).Value
End Select
' Anfangsdatum nächster Monat auf Zeitachse
Select Case Month(klDatum)
Case 1, 3, 5, 7, 8, 10, 12:
iDatDiff = 31
Case 2:
iDatDiff = 28
If Year(klDatum) Mod 2 = 0 Then iDatDiff = 29
Case Else:
iDatDiff = 30
End Select
klDatum = klDatum + iDatDiff
If klDatum > grDatum Then
i = i + 1
Exit For
End If
iSpalte = iSpalte + 1
Next j
Next i
z = i
k = .Range("B105").End(xlUp).Row
iZeile = .Range("B100").End(xlUp).Row + 1
For i = 25 To Worksheets(sTbl3).Range("B105").End(xlUp).Row Step 2
.Cells(iZeile, 2).Value = Worksheets(sTbl3).Cells(i, 2).Value
For j = Worksheets(sTbl3).Range("D26") To Worksheets(sTbl3).Range("BC26")
For iSpalte = 2 To .Range("B2").End(xlToRight).Column
If Month(.Cells(iZeile, iSpalte).Value) = Month(.Cells(i, j).Value) Then
If Year(.Cells(iZeile, iSpalte).Value) = Year(.Cells(i, j).Value) Then
.Cells(iZeile, iSpalte).Value = Worksheets(sTbl3).Cells(j, i).Value
Exit For
End If
End If
Next iSpalte
If j = 48 Then j = 45
If j = 28 Then
If .Cells(iZeile, j).Value = "" Then .Cells(iZeile, j).Value = 0
j = j + 1
End If
If .Cells(iZeile, j).Value = "" Then .Cells(iZeile, j).Value = .Cells(iZeile, j - 1).Value
Next j
For j = iSpalte + 1 To z - 1
.Cells(iZeile, j).Value = 0
Next j
iZeile = iZeile + 1
Next i
.Cells(iZeile - 1, 2).Value = "Differenz"
For j = 3 To z
iIst = 0
For i = (k + 3) To (iZeile - 1)
iIst = iIst + .Cells(i, j).Value
Next i
.Cells(iZeile, j).Value = Worksheets(sTbl3).Range("C106").Value - iIst
If .Cells(iZeile, j).Value < 0 Then .Cells(iZeile, j).Value = 0
Next j
iZeile = iZeile + 1
.Cells(iZeile - 1, 2).Value = "Gesamtfälle"
For i = 2 To z
igesamt = Worksheets(sTbl3).Range("C105").Value
Next i
End With
Exit Sub
Gruß coena
|