Schleife in der Schleife (Fortsetzung)
Martin
ich schaffe es einfach nicht auf deinen Beitrag zu ID 1156864 zu antworten... dein Code funktioniert super! Jetzt habe ich aber noch ein "optisches" Problem: In der Hilfstabelle wird für jedes Währungspaar ein Datum reinkopiert in dem Format 19.05.2010. Da dies die x-Achse der Grafik wird hätte ich aber gerne nur 19.5 stehen. Die Funktion DateValue ist aber leider mit dem Typen nicht verträglich. Deshalb habe cih versucht, eine weitere Spalte einzufügen um die Funktion DateValue direkt in Excel (und nicht in VBA) zu machen denn da klappt es. Ich scheitere aber daran, deinen Code in diese Richtung zu verändern, dass die zweite Splate jeder Hilfstabelle leer bleibt, dh
arrE(2 + 5 * lngT, 1 + lngE(lngT)) = arrQ(lngQ, 4)
soll erst in der dritten Spalte stehen und nicht in der zweiten. Danke für deine Hilfe! Hier noch mal der ganze Code:
Sub Uebertrage5()
Dim arrT, arrQ, lngE() As Long, lngQ As Long, lngT As Long, arrE(), lngM As Long
arrT = Split("EUR/CHF EUR/GBP EUR/JPY USD/JPY EUR/USD GBP/USD") ' Währungen
With Worksheets("MTD_per_Day") ' Quellblatt
arrQ = .Cells(1, 1).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row, 8)
End With
ReDim lngE(UBound(arrT))
ReDim arrE(1 To 4 + 5 * UBound(arrT), 1 To UBound(arrQ))
For lngQ = 1 To UBound(arrQ)
For lngT = 0 To UBound(arrT)
If arrQ(lngQ, 2) = arrT(lngT) Then
arrE(1 + 5 * lngT, 1 + lngE(lngT)) = arrQ(lngQ, 3)
arrE(2 + 5 * lngT, 1 + lngE(lngT)) = arrQ(lngQ, 4)
arrE(3 + 5 * lngT, 1 + lngE(lngT)) = arrQ(lngQ, 6)
arrE(4 + 5 * lngT, 1 + lngE(lngT)) = arrQ(lngQ, 8)
lngE(lngT) = lngE(lngT) + 1
End If
Next lngT
Next lngQ
lngM = Application.Max(lngE)
ReDim Preserve arrE(1 To 4 + 5 * UBound(arrT), 1 To lngM)
With Worksheets("Hilfstabellen") ' Ausgabeblatt
.Cells(19, 1).Resize(UBound(arrE, 2), UBound(arrE)) = Application.Transpose(arrE)
End With
End Sub