Hallo zusammen, ich möchte alle möglichen Kombination von den Werten in der Spalte A und Spalte B bilden. Mit der bisherigen Codierung erhalte ich mit dem Klicken auf "Schaltfläche" das in schwarz geschriebene Ergebnis. Ich möchte jedoch das rote Ergebnis erreichen. Anbei ist die Excel Datei zu finden. Dateiupload bitte im Forum! So geht es: Klick mich! " border="0">
in Deiner Beispieltabelle sind die Daten zuerst nach Spalte A sortiert. Dadurch könntest Du beim Eintrag in die Tabelle vom einzutragenden Inhalt die Buchstabenkombination mit dem entsprechenden vorherigen Wert Deiner Collection vergleichen, z.B. mit der MID - Funktion. Sind die Einträge unterschiedlich, schiebst Du den zusätzlichen "kurzen" davor und erst eine Zeile später den richtigen ...
Wenn der Code von Dir ist, sollte die Programmierung kein Problem sein. Falls nicht, melde Dich nochmal.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
in Deiner Beispieltabelle sind die Daten zuerst nach Spalte A sortiert. Dadurch könntest Du beim Eintrag in die Tabelle vom einzutragenden Inhalt die Buchstabenkombination mit dem entsprechenden vorherigen Wert Deiner Collection vergleichen, z.B. mit der MID - Funktion. Sind die Einträge unterschiedlich, schiebst Du den zusätzlichen "kurzen" davor und erst eine Zeile später den richtigen ...
Wenn der Code von Dir ist, sollte die Programmierung kein Problem sein. Falls nicht, melde Dich nochmal.
Hallo schauan, die Codierung gehört nicht mir. Kannst du bitte dabei helfen? Danke Vg Juilias
zum Beispielcode gehört noch die größere Dimensionierung des Arrays
Code:
ReDim avntErgebnis(1 To colA.Count * colB.Count + colA.Count, 1 To 1)
Eine fehlerhafte Zusammenstellung gibts übrigens nicht nur am Ende. Wenn Du mal irgendwo einen Namen änderst, z.B. in Otto, dann bekommst Du diesen in allen Gruppen und nicht nur dort, wo Du ihn geändert hast.
Als Lösung würde sich da eine Collection anbieten und nicht zwei. Schaue ich mir heute Abend noch mal an.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
hier ist jetzt der code. Ich habe einige Kommentare drin und hoffe, dass Dir das weiter hilft.
Code:
Sub Schaltfläche1_Klicken()
Dim vntElement As Variant Dim arrElement As Variant Dim colA As Collection Dim lngIndexA As Long
Dim avntErgebnis() As Variant Dim iavntErgebnis As Long Dim vehicleCodeNumber As Long Dim ptMatchingPart As Long
Set colA = New Collection 'Daten in Array uebernehmen arrElement = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp).Offset(1, 1)).Value 'Schleife ueber alle Arrayelemente For icnt = LBound(arrElement, 1) To UBound(arrElement, 1) 'wenn erstes Feld des aktuellen Arrayeintrags nicht leer ist, dann If Not IsEmpty(arrElement(icnt, 1)) Then 'Collectionelement aus erstem und zweitem Feld des aktuellen Arrayeintrages bilden Call UnikateSammeln(colA, arrElement(icnt, 1) & " " & arrElement(icnt, 2)) ' Element in Array hinzufügen 'ab dem zweiten Schleifendurchlauf If icnt > 1 Then 'Wenn sich die Vehiclecodenummer aendert, dann If arrElement(icnt, 1) <> arrElement(icnt - 1, 1) Then 'Vehiclecodenummer 1 hochsetzen vehicleCodeNumber = vehicleCodeNumber + 1 'Ende Wenn sich die Vehiclecodenummer aendert, dann End If 'Ende ab dem zweiten Schleifendurchlauf End If 'Ende wenn erstes Feld des aktuellen Arrayeintrags nicht leer ist, dann End If 'Ende Schleife ueber alle Arrayelemente Next Range(Cells(2, 3), Cells(2, 3).End(xlDown)).ClearContents 'Array dimensioniren anhand collectioneintraegen und vehiclecodenummern ReDim avntErgebnis(1 To colA.Count + vehicleCodeNumber + 1, 1 To 1) 'Zaehler auf Startwert setzen vehicleCodeNumber = 1 iavntErgebnis = 1 ptMatchingPart = 1 'Schleife ueber alle Collectioneintraege For lngIndexA = 1 To colA.Count 'Wenn der Schleifenzaehler groesser 1 ist, dann If lngIndexA > 1 Then 'Wenn der vehiclecode sich aendert If Split(colA(lngIndexA - 1), " ")(0) <> Split(colA(lngIndexA), " ")(0) Then 'arrayeintrag ohne Name bilden avntErgebnis(iavntErgebnis, 1) = "Total " & Chr(34) & " CODE " & _ vehicleCodeNumber & Chr(34) & " " & Chr(34) & "PART " & ptMatchingPart & Chr(34) & " - " & Split(colA(lngIndexA - 1), " ")(0) 'Zaehler setzen vehicleCodeNumber = vehicleCodeNumber + 1 iavntErgebnis = iavntErgebnis + 1 'Counter ptMatchingPart = 1 'Ende Wenn der vehiclecode sich aendert End If 'Ende Wenn der Schleifenzaehler groesser 1 ist, dann End If 'arrayeintrag mit Name bilden avntErgebnis(iavntErgebnis, 1) = "Total " & Chr(34) & " CODE " & _ vehicleCodeNumber & Chr(34) & " " & Chr(34) & "PART " & ptMatchingPart & Chr(34) & " - " & _ colA(lngIndexA) 'Zaehler setzen ptMatchingPart = ptMatchingPart + 1 'Counter iavntErgebnis = iavntErgebnis + 1 'Counter 'Ende Schleife ueber alle Collectioneintraege Next 'letzter Vehicle-Eintrag avntErgebnis(iavntErgebnis, 1) = "Total " & Chr(34) & " CODE " & _ vehicleCodeNumber & Chr(34) & " " & Chr(34) & "PART " & ptMatchingPart & Chr(34) & " - " & Split(colA(lngIndexA - 1), " ")(0) 'Ausgabe Cells(2, 3).Resize(iavntErgebnis).Value = avntErgebnis Set colA = Nothing ' referenzierten Objekts freigegeben End Sub
Private Sub UnikateSammeln(ByRef colSammlung As Collection, ByVal vntElement As Variant) On Error Resume Next colSammlung.Add vntElement, CStr(vntElement) On Error GoTo 0 End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Dateiupload bitte im Forum! So geht es: Klick mich!
