Thema: Teilungszahlen und Sitzfolge nach dem Höchstzahlverfahren

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

Beiträge aus dem Excel-Forum zu den Themen Funktion und ZÄHLENWENN