Bereich vergleichen und markieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

ich habe dir die Dauer des Makroablaufs noch eingebaut...
und etwas schneller gemacht...
bei mit dauert es bei 1000 Zeilen der linken Liste ca. 2 sec

Sub suchen()
Dim arr1, arr2
Dim lz&, lz1&, i&, z&, x As Byte, a As Byte
Dim t As Double
lz = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
t = Timer
For i = 1 To lz
    For z = 1 To 12  'diesen Bereich bei Liste >12 Zeilen anpassen

arr1 = Array(Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 4), Cells(i, 5), _
                 Cells(i, 6), Cells(i, 7), Cells(i, 8), Cells(i, 9))

arr2 = Array(Cells(z, 13), Cells(z, 14), Cells(z, 15), Cells(z, 16), Cells(z, 17), _
                 Cells(z, 18), Cells(z, 19), Cells(z, 20), Cells(z, 21))
         For a = 0 To 8
             If arr1(a) = arr2(a) Then
               x = x + 1
                If x = 9 Then
                  Range(Cells(i, 1), Cells(i, 9)).Interior.ColorIndex = 3
                  x = 0
                End If
              Else: Exit For
            End If
         Next
     x = 0
  Next
Next
Application.ScreenUpdating = True
MsgBox "Aktualisierungsdauer :  " & _
        Format(Timer - t, "#0.00") & " Sekunden"
End Sub

gruß Herbert

hallo jusuf
drückst du Alt+F11.
das steht der code.
der macht nichts anderes als jeden 9er block im bereich1 mit jedem 9er Block im
bereich2 zu vergleichen.
wenn alle zellen in den blöcken übereistimmen wird die farbe zugewiesen und der nächste
9er Block kommt an die reihe.
Option Explicit
Public Sub mach_bunt()
Dim bereich1() As Variant
Dim bereich2() As Variant
Dim L As Long
Dim K As Long
Dim b1 As Integer
Dim x As Integer
              For K = 3 To 86 'hier die zeilen für bereich1 anpassen
                    For L = 3 To 14 'hier die zeilen für bereich1 anpassen
                    bereich2 = Array(Cells(K, 2), Cells(K, 3), Cells(K, 4), Cells(K, 5), Cells(K, 6), Cells(K, 7), Cells(K, 8), Cells(K, 9), Cells(K, 10))
                    bereich1 = Array(Cells(L, 14), Cells(L, 15), Cells(L, 16), Cells(L, 17), Cells(L, 18), Cells(L, 19), Cells(L, 20), Cells(L, 21), Cells(L, 22))
                              For b1 = 0 To 8
                                        If bereich1(b1) <> bereich2(b1) Then 'hier wird jede zelle in dem 9er Block in den bereichen verglichen
                                                  x = 0
                                                  Exit For
                                                  Else:
                                                  x = x + 1
                                                  If x = 9 Then
                                                            Range(Cells(K, 2), Cells(K, 10)).Interior.ColorIndex = 17 'Hier wird die farbe zugewiesen
                                                            x = 0
                                                            GoTo weiter
                                                  End If
                                        End If
                              Next
                    Next
weiter:
          Next
End Sub
ransi

Beliebteste Forumthreads (12 Monate)

Bereich vergleichen und markieren

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bereich vergleichen und markieren

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread