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!