Spalte durchsuchen und in andere Spalte x setzen

Hallo
ich hoffe ihr könnt mir bei meinem Problem helfen.
Problemstellung:
Ich habe eine Excel Liste, diese enthält eine Spalte die komplett durchsucht werden soll.
Die jeweiligen Zellen enthalten mehrere String der Form "XX123456789" die Strings innerhalb der Zelle sind durch ein ; getrennt.
Nun gibt es eine beliebige Anzahl von Zellen die alle nach dem Schema wie oben gefüllt sind, manche haben mehr manche weniger Einträge.
Die XX am Anfang der Strings sind mehrere verschiedene wiederkehrende Kombinationen.
Es sollen für jede Kombination der XX'e eine eigene Spalte angehängt werden (wird manuell davor erledigt).
Nun soll die gesamte Spalte angefangen bei der 1. Zelle durchgegangen werden und stoppen wenn er auf die Zelle stößt wo keinen Eintrag mehr enthält.
Innerhalb einer Zelle soll das Makro nun erkennen um welches XX es sich handelt und in der jeweilig passenden angefügten Spalte eine "x" machen.
Wenn es nun auf ein ; trifft soll es zum nächsten String der Zelle springen oder wenn nach dem ; kein String mehr kommt in die darunter liegende Zelle springen.
Dadurch soll eine besser Übersicht entstehen welche Kombinationen alle in einer Zelle vorkommen.
Es wäre super wenn mir jemand sagen/zeigen könnte wie man das am besten realisiert.
Viele Grüße und Danke schon mal

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Set_X() Dim i As Long, j As Byte, a As Long Dim vX As Variant Dim sSuche As String '\\ Startvariable für Schleife über alle Zeilen i = 2 '\\Schleife für Zeilen Do Until Cells(i, 3) = "" '\\aktuellen Zellinhalt splitten und in ein Array schieben vX = Split(Cells(i, 3), ";") '\\ Schleife über Arrayinhalt For a = LBound(vX) To UBound(vX) '\\Leerzeichen rausnehmen sSuche = Trim(vX(a)) '\\ Buchstaben separieren sSuche = Left(sSuche, 2) Debug.Print sSuche '\\Schleife über Kopfzeile und 'x' setzen '\\ Start: Spalte 7 '\\ Ende: Spalte 10 ggf. anpassen For j = 7 To 10 If sSuche = Cells(1, j) Then Cells(i, j) = "x" Exit For End If Next j Next i = i + 1 Loop End Sub

Private Sub Set_X() Dim i As Long, j As Byte, a As Long Dim vX As Variant Dim sSuche As String Dim stmp As String '\\ Startvariable für Schleife über alle Zeilen i = 2 '\\Schleife für Zeilen Do Until Cells(i, 3) = "" '\\Zeilenumbrüche entfernen stmp = Replace(Cells(i, 3), vbLf, " ", 1, -1, 1) '\\aktuellen Zellinhalt splitten und in ein Array schieben vX = Split(stmp, ";") '\\ Schleife über Arrayinhalt For a = LBound(vX) To UBound(vX) '\\Leerzeichen rausnehmen sSuche = Trim(vX(a)) '\\ Buchstaben separieren sSuche = Left(sSuche, 2) Debug.Print sSuche '\\Schleife über Kopfzeile und 'x' setzen '\\ Start: Spalte 7 '\\ Ende: Spalte 10 ggf. anpassen For j = 7 To 10 If sSuche = Cells(1, j) Then Cells(i, j) = "x" Exit For End If Next j Next i = i + 1 Loop End Sub

Beliebteste Forumthreads (12 Monate)

Spalte durchsuchen und in andere Spalte x setzen

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalte durchsuchen und in andere Spalte x setzen

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread