Zellteile mit Matrix vergleichen

Hallo liebe Forumsmitglieder,
ich stehe hier vor einem kleinen Problem.
Ich habe eine Exceltabelle in der in einer Spalte mehrere 8stellige Kennzahlen (2 bis 9 Kennzahlen) in einer Zelle stehen immer mit Komma getrennt.
Nun muß ich die einzelnen Kennzahlen mit einer Matrix vergleichen und diese dann entsprechend ändern.
Beispiel.
A1 enthält:
ABC01G00,ABC02G01,ABC04G00,ABC02R01
ABC01G00 entspricht "Daten doppelt vorhanden"
ABC02G01 entspricht "Daten geprüft gegen Referenzdatei"
ABC04G00 entspricht "Daten komplett"
ABC02R01 entspricht " Daten in Spalte x1 geändert"
Die Liste der Code beträgt ingesamt 100 verschiedene Varianten
Als Ergebnis soll dann rauskommen:
ABC01G00 in A1 Löschen und Zeile 1 Rot einfärben
ABC02G01 in A1 "Daten geprüft gegen Referenzdatei" als Klartext eintragen
ABC04G00 in A1 "Daten komplett" als Klartext eintragen
ABC02R01 in A1 Lösche und Zelle x1 in blau einfärben
Ich hatte bisher nur die Idee, mit suchen - ersetzten, da gibt es bestimmt noch besseres.
Vielen Dank im Voraus.
Alfred

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim i For i = 1 To 10 Range("A" & i).Replace what:="ABC02G01", replacement:="Daten geprüft gegen Referenzdatei" Range("A" & i).Replace what:="ABC04G00", replacement:="Daten komplett" If Not IsError(Application.Find("ABC01G00", Range("A" & i), 1)) Then Range("A" & i) = Replace(Range("A" & i), "ABC01G00,", "") Rows(i).Interior.ColorIndex = 3 End If If Not IsError(Application.Find("ABC02R01", Range("A" & i), 1)) Then Range("A" & i) = Replace(Range("A" & i), ",ABC02R01", "") Range("A" & i).Interior.ColorIndex = 5 End If Next End Sub

Servus,
ich hab's etwas anders gelöst:
Option Explicit


Sub t()
Dim VergleichsArray(1 To 4, 1 To 2)
Dim Index, lngLetzte As Long
Dim i As Long, z As Long, Lauf As Long
VergleichsArray(1, 1) = "ABC01G00"
VergleichsArray(1, 2) = 1
VergleichsArray(2, 1) = "ABC02G01"
VergleichsArray(2, 2) = 2
VergleichsArray(3, 1) = "ABC04G00"
VergleichsArray(3, 2) = 3
VergleichsArray(4, 1) = "ABC02R01"
VergleichsArray(4, 2) = 4
lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row
For Lauf = 1 To lngLetzte
Index = Split(Cells(Lauf, 1), ",")
For i = 0 To UBound(Index)
For z = 1 To UBound(VergleichsArray(), 1)
If Trim(Index(i)) = VergleichsArray(z, 1) Then
Select Case VergleichsArray(z, 2)
Case 1:
If Cells(Lauf, 1).Interior.ColorIndex  5 Then
Rows(Lauf).Interior.ColorIndex = 3
Index(i) = ""
Else
Rows(Lauf).Interior.ColorIndex = 3
Cells(Lauf, 1).Interior.ColorIndex = 5
End If
Case 2:
Index(i) = "Daten geprüft gegen Referenzdatei"
Case 3:
Index(i) = "Daten komplett"
Case 4:
Index(i) = ""
Cells(Lauf, 1).Interior.ColorIndex = 5
End Select
End If
Next z
Next i
Cells(Lauf, 1) = ""
For i = 0 To UBound(Index)
If Index(i)  "" Then
If Cells(Lauf, 1) = "" Then
Cells(Lauf, 1) = Index(i)
Else
Cells(Lauf, 1) = Cells(Lauf, 1) & "," & Index(i)
End If
End If
Next i
Next Lauf
End Sub

Gruß
Chris

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread