Hallo!
Brauche dringend Hilfe bei dem folgendem Code!!!
Sub testing()
Dim dClient As Object, dDesign As Object
Dim arrFrom(), arrTo(), acKeys(), adKeys()
Dim i%, j%, k%
Set dClient = CreateObject("Scripting.Dictionary")
Set dDesign = CreateObject("Scripting.Dictionary")
With Sheets("Tabelle1")
arrFrom = .Range(.[a2], .[c2].End(xlDown)).Value
For i = 1 To UBound(arrFrom)
If dClient.exists(arrFrom(i, 1)) Then
arrFrom(i, 1) = dClient.Item(arrFrom(i, 1))
Else
j = j + 1: dClient.Add arrFrom(i, 1), j: arrFrom(i, 1) = j
End If
If dDesign.exists(arrFrom(i, 3)) Then
arrFrom(i, 3) = dDesign.Item(arrFrom(i, 3))
Else
k = k + 1: dDesign.Add arrFrom(i, 3), k: arrFrom(i, 3) = k
End If
Next
ReDim arrTo(1 To j + 1, 1 To k + 1)
acKeys = dClient.keys: adKeys = dDesign.keys
Set dClient = Nothing: Set dDesign = Nothing
For i = 0 To j - 1: arrTo(i + 2, 1) = acKeys(i): Next
For i = 0 To k - 1: arrTo(1, i + 2) = adKeys(i): Next
For i = 1 To UBound(arrFrom)
If IsEmpty(arrTo(arrFrom(i, 1) + 1, arrFrom(i, 3) + 1)) Then
arrTo(arrFrom(i, 1) + 1, arrFrom(i, 3) + 1) = arrFrom(i, 2)
Else
arrTo(arrFrom(i, 1) + 1, arrFrom(i, 3) + 1) = _
arrTo(arrFrom(i, 1) + 1, arrFrom(i, 3) + 1) & vbCrLf & arrFrom(i, 2)
End If
Next
Sheets("Tabelle2").[a1].Resize(UBound(arrTo), UBound(arrTo, 2)).Value = arrTo
' in der Zeile oben kommt der Fehler!!!
End With
Sheets("Tabelle2").Columns.AutoFit
End Sub
Dieser nimmt drei Spalter aus Tabelle1 und sortiert diese: spalte a steht links. spalte c steht oben: die werte in spalte b werden entsprechend sortiert. Man sieht also, zu welchem Wert der Wert aus b zu Werten in a und c gehört. in Tabelle2 steht dann das sortierte Ergebnis. Bei wenigen Zeilen in den Spalten sortiert er ohne Probleme! Sobald man aber mehr Zeilen hat - schimpft er auf die Zeile:
Sheets("Tabelle2").[a1].Resize(UBound(arrTo), UBound(arrTo, 2)).Value = arrTo
Dazu schreibt er dann Laufzeitfehler 1004, anwendungs- oder objektorientierter Fehler! Wieso er das macht, ist mir rätselhaft - der code brauch ich dringend in funktionierender Weise.
Danke allen im Voraus für die Hilfe!!!!
|