Gruppe
Allgemein
Problem
Aus der ersten Spalte sollen die Teilstrings Position 2 bis 5 und 7 bis 10 der Werte mit den Teilstrings aller Werte aus Spalte B verglichen werden. Gibt es keine Übereinstimmung, wird die Zelle in Spalte A gekennzeichnet.
StandardModule: Modul1
Sub Vergleich()
a = 1
Do While 1
zahl1 = Cells(a, 1)
zahl1pos2bis5 = Mid(zahl1, 2, 4) ' bei 123456789100000 ... 2345
zahl1pos7bis10 = Mid(zahl1, 7, 4) ' ... 7891
b = 1
fehler = 0
Do While 1
zahl2 = Cells(b, 2)
zahl2pos2bis5 = Mid(zahl2, 2, 4) ' bei 123456789100000 ... 2345
zahl2pos7bis10 = Mid(zahl2, 7, 4) ' ... 7891
If zahl2pos2bis5 <> zahl1pos2bis5 Or zahl1pos2bis5 <> zahl2pos7bis10 Then
fehler = 1
End If
b = b + 1
If Cells(b, 2) = "" Then Exit Do ' Leere Zelle = Ende Spalte 1
Loop
If fehler <> 0 Then
MsgBox "Error! Spalte A Reihe " & a & " nicht in Spalte B gefunden!"
End If
a = a + 1
If Cells(a, 1) = "" Then Exit Do ' Leere Zelle = Ende Spalte 1
Loop
End Sub
StandardModule: basMain
Sub Vergleichen()
Dim iRowA As Integer, iCounter As Integer, iFirst As Integer, iSecond As Integer
Dim iRowB As Integer
Dim sTxtA As String, sTxtB As String
Dim bln As Boolean
iRowA = 1
iFirst = 1
iSecond = 2
For iCounter = 1 To 2
Do Until IsEmpty(Cells(iRowA, iFirst))
bln = False
iRowB = 1
sTxtA = Cells(iRowA, iFirst).Value
Do Until IsEmpty(Cells(iRowB, iSecond))
sTxtB = Cells(iRowB, iSecond).Value
If Mid(sTxtA, 2, 4) = Mid(sTxtB, 2, 4) And _
Mid(sTxtA, 7, 4) = Mid(sTxtB, 7, 4) Then
bln = True
Exit Do
End If
iRowB = iRowB + 1
Loop
If bln = False Then Cells(iRowA, iFirst).Interior.ColorIndex = 6
iRowA = iRowA + 1
Loop
iFirst = 2
iSecond = 1
iRowA = 1
Next iCounter
End Sub