schöne und interessante Aufgaben, die Du uns hier stellst.
Dann teste mal:
Code:
Option Explicit
Sub test()
Dim i As Long, j As Long, k As Long, x As Long
Dim lngZ As Long
Dim varKey
Dim varFeld1, varFeld2, arrX
Dim arr1(), arr2()
Dim objDic As Object
varFeld1 = Range("ER1:GA1")
varFeld2 = Range("ER2:GA2")
Set objDic = CreateObject("Scripting.Dictionary")
For j = 1 To 36
varKey = varFeld2(1, j)
If varFeld2(1, j) <> "" And InStr(objDic(varKey), varFeld2(1, j) & "##" & varFeld1(1, j)) = 0 Then
objDic(varKey) = objDic(varKey) & "##" & varFeld1(1, j)
End If
Next j
j = 0
ReDim arr1(objDic.Count - 1)
ReDim arr2(objDic.Count - 1, 35)
For Each varKey In objDic
arrX = Split(RTrim(objDic(varKey)), "##")
x = UBound(Split(RTrim(objDic(varKey)), "##"))
arr1(j) = varKey
For i = 1 To x
arr2(j, k) = arrX(i)
k = k + 1
Next i
29.01.2015, 13:09 (Dieser Beitrag wurde zuletzt bearbeitet: 29.01.2015, 13:39 von atilla.)
Hallo Angelina,
der Code funktioniert zwar, aber da sind doch einige Dinge überflüssig und
einiges kann man noch zusammenfassen.
deshalb und weil Du Dich immer so nett bedankst, habe ich hier eine verbesserte und abgespeckte Version:
Code:
Option Explicit
Sub test()
Dim i As Long, j As Long, k As Long
Dim lngZ As Long
Dim varKey
Dim varFeld1
Dim arr1()
Dim objDic As Object
varFeld1 = Range("ER1:GA2")
Set objDic = CreateObject("Scripting.Dictionary")
For j = 1 To 36
varKey = varFeld1(2, j)
If varFeld1(2, j) <> "" And InStr(objDic(varKey), varFeld1(2, j) & "##" & varFeld1(1, j)) = 0 Then
objDic(varKey) = objDic(varKey) & "##" & varFeld1(1, j)
End If
Next j
j = 0
ReDim arr1(objDic.Count - 1, 36)
For Each varKey In objDic
arr1(j, 0) = varKey
For i = 1 To UBound(Split(objDic(varKey), "##"))
arr1(j, k + 2) = arrX(i)
k = k + 1
Next i
k = 0
j = j + 1
Next varKey
Übrigens, man kann Dir punktgenaue Vorschläge machen, weil deine Erklärungen auch punktgenau sind. Das ist selten, dass der Fragesteller die Problemstellung so detailliert und für den Helfer verständlich darstellt. :28:
Gruß Atilla
Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:1 Nutzer sagt Danke an atilla für diesen Beitrag 28 • Angelina
02.02.2015, 07:45 (Dieser Beitrag wurde zuletzt bearbeitet: 02.02.2015, 07:46 von Angelina.)
hallo atilla,
erstmal muß ich mich entschuldigen, das ich erst jetzt antworte.
Ich habe keine Info vom Forum bekommen das eine neue Nachricht da ist.
Hatte vergessen abonnieren anzuklicken.
Bitte - Bitte entschuldige dies - es ist wirklich nicht meine Art - umgehend zu antworten.
Danke dir das du dir soviel Mühe machst. Ich habe deinen neuen VBCode eben mal testen wollen
da bekomme ich die Meldung "Sub oder Funktion nicht definiert" und zwar hier: