Das Ergebnis in Spalte D und E.
Der Code für ein allgemeines Modul:
Public Sub Aufteilung_Trennzeichen_Komma()
'Code für ein allgemeines Modul
'*********************************
'Autor: Jürgen Hennekes
'*********************************
Dim DicScr As Object
Dim lngZQ As Long
Dim lngZZ As Long
Set DicScr = CreateObject("Scripting.Dictionary")
For lngZQ = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If DicScr.exists(Cells(lngZQ, 1).Value) = False Then
DicScr.Add Cells(lngZQ, 1).Value, lngZQ
lngZZ = lngZZ + 1
Cells(lngZZ, 4).Value = Cells(lngZQ, 1).Value
Cells(lngZZ, 5).Value = Cells(lngZQ, 2).Value
Else
Cells(lngZZ, 5).Value = Cells(lngZZ, 5).Value & ", " & Cells(lngZQ, 2).Value
End If
Next
End Sub
Sollen die Werte in getrennte Zellen geschrieben werden, dann so:
Public Sub Aufteilung_in_neue_Zelle()
'Code für ein allgemeines Modul
'*********************************
'Autor: Jürgen Hennekes
'*********************************
Dim DicScr As Object
Dim lngZQ As Long
Dim lngZZ As Long
Dim intS As Integer
Set DicScr = CreateObject("Scripting.Dictionary")
'intS = 5
For lngZQ = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If DicScr.exists(Cells(lngZQ, 1).Value) = False Then
DicScr.Add Cells(lngZQ, 1).Value, lngZQ
lngZZ = lngZZ + 1
intS = 5
Cells(lngZZ, 4).Value = Cells(lngZQ, 1).Value
Cells(lngZZ, 5).Value = Cells(lngZQ, 2).Value
Else
intS = intS + 1
Cells(lngZZ, intS).Value = Cells(lngZQ, 2).Value
End If
Next
End Sub
Interessant ist sicherlich auch der umgekehrte Fall.
In Spalte A steht jeder Begriff einmalig, in Spalte B sind mehrere Begriffe durch ein Komma getrennt.
Die Daten sollen in 2 Spalten ( hier D und E ) untereinander angeordnet werden.
Der Code:
Public Sub In_Spalten_anordnen()
'Code für ein allgemeines Modul
'*********************************
'Autor: Jürgen Hennekes
'*********************************
Dim SPL
Dim lngZQ As Long
Dim lngZZ As Long
Dim intZ As Integer
Dim lngLast As Long
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
lngZZ = 1
For lngZQ = 1 To lngLast
SPL = Split(Cells(lngZQ, 2), ",")
For intZ = 0 To UBound(SPL)
Cells(lngZZ, 4).Value = Cells(lngZQ, 1).Value
Cells(lngZZ, 5).Value = LTrim(RTrim(SPL(intZ)))
lngZZ = lngZZ + 1
Next
Next
End Sub
Oder die Daten stehen wie im 2. Beispiel nach Codeausführung "Public Sub Aufteilung_in_neue_Zelle()" jeweils in einer eigenen Zelle.
Die Daten sollen aus dem Tabellenblatt "Quelle" in das Tabellenblatt "Ziel" in Spalte A und B geschrieben werden.
Die Anzahl der Spalten, hier Standorte, ist nicht relevant, da sie vom Code erkannt wird.
Der Code:
Public Sub In_Spalten_anordnen2()
''Code für ein allgemeines Modul
'*********************************
'Autor: Jürgen Hennekes
'*********************************
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lngZQ As Long
Dim lngZZ As Long
Dim intS As Integer
Dim lngLast As Long
Set wksQ = Worksheets("Quelle") '<--- Tabellenblattname bitte anpassen
Set wksZ = Worksheets("Ziel") '<--- Tabellenblattname bitte anpassen
lngLast = wksQ.Cells(Rows.Count, 1).End(xlUp).Row
lngZZ = 1
With wksQ
For lngZQ = 2 To lngLast
For intS = 2 To .Cells(lngZQ, Columns.Count).End(xlToLeft).Column
wksZ.Cells(lngZZ, 1).Value = .Cells(lngZQ, 1).Value
wksZ.Cells(lngZZ, 2).Value = .Cells(lngZQ, intS).Value
lngZZ = lngZZ + 1
Next
Next
End With
End Sub
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
