Bereich vergleichen und markieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Bereich vergleichen und markieren
von: Jusuf
Geschrieben am: 11.02.2005 16:13:25
Hallo,
in Tabelle1 habe ich zwei Bereiche: Bereich1="A1:I85" und Bereich2="M1:U13". Ich möchte aus Bereich2 erste Zeile ("M1:U1") in Bereich1 ("A1:I85") suchen und bei Übereinstimmung farblich markieren. Dann aus Bereich2 zweite Zeile ("M2:U2") nehmen und in Bereich1 ("A1: I85") suchen und bei Übereinstimmung farblich markieren und so weiter. In jeder Zeile sind 6 (sechs) unterschiedliche Spalten mit einem x1 bis x9 belegt.
Bereich1 kann bis 55000 Zeilen groß werden.
Bereich2 kann bis 1500 Zeilen groß werden.
Alle meine versuche waren ohne Erfolg. Wer kann mir dabei helfen eine VGA Lösung zu finden?

In voraus danke.
Jusuf

Bild

Betrifft: AW: Bereich vergleichen und markieren
von: Ransi
Geschrieben am: 11.02.2005 18:41:35
Hallo Jusuf
Konventionell Kann ich dir was anbieten.:
https://www.herber.de/bbs/user/17877.xls
bei 55000 datensätzen wird das aber eine Riesendatei.
ransi
Bild

Betrifft: AW: Bereich vergleichen und markieren
von: HerbertH
Geschrieben am: 11.02.2005 23:35:11
wenn du eine VBA-Lösung brauchst...


Sub suchen()
Dim lz&, lz1&, i&, i1&, x As Byte
Dim As Byte, s1 As Byte
lz = Cells(Rows.Count, 1).End(xlUp).Row
lz1 = Cells(Rows.Count, 13).End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lz
 For i1 = 1 To lz1
   For s1 = 13 To 21
     For s = 1 To 9
       If Cells(i1, s1) = Cells(i, s) Then
         Cells(i, s).Interior.ColorIndex = 3
        End If
      Next
    Next
  Next
Next

For i = 1 To lz
  For s = 1 To 9
    If Cells(i, s).Interior.ColorIndex = 3 Then
      x = x + 1
    End If
   Next
   
      For s = 1 To 9
        If x < 9 Then
          Cells(i, s).Interior.ColorIndex = xlNone
        End If
      Next
  x = 0
Next

Application.ScreenUpdating = True
End Sub

     gruß Herbert
Bild

Betrifft: AW: Bereich vergleichen und markieren
von: Jusuf
Geschrieben am: 12.02.2005 11:30:52
Hallo Hans,
danke für deine Hilfe. Dein Makro markiert leider ganzen Bereich1 und das ist nicht
wünschenswert. Viel mehr soll so aussehen wie unten gezeigt.
Muster aus Bereich2: "M1:U1" ist zu suchen in Bereich1: "A1:I84" und wenn gleich, dann markieren. z.B. "M1:U1" hat: x1,x2,x3,x4,x5,x6,leer,leer,leer (leer = leere Celle)
Irgendwo im Bereich1 "A1:I84" steht gleiche Muster wie in "M1:U1", z.B. in "A1:I1".Das soll man finden und Markieren. Und so weiter...
Wie kann ich Tabelle1 hier zeigen?
mfg Jusuf
Bild

Betrifft: wer ist Hans...? ...o.T.
von: HerbertH
Geschrieben am: 12.02.2005 11:46:13
...
Bild

Betrifft: AW: wer ist Hans...? ...o.T.
von: Jusuf
Geschrieben am: 12.02.2005 11:51:16
Hallo,
Ich nehme an HerbertH, wobai H für Hans steht.

mfg Jusuf
Bild

Betrifft: stimmt nicht ganz...
von: Herbert Hainberger
Geschrieben am: 12.02.2005 12:56:51
ich war mir ohnedies nicht ganz sicher,
ob du das so gemeint hast...
kannst du eine kleine Mustertabelle hochladen,
wie das jetzt tatsächlich aussehen sollte...
gruß Herbert
Bild

Betrifft: AW: stimmt nicht ganz...
von: Jusuf
Geschrieben am: 12.02.2005 15:04:42
Hallo,
Ich entschuldige mich. Jetzt weiß ich was hinter HerbertH steht.
Die Mappe1 habe ich gerade hochgeladen.
https://www.herber.de/bbs/user/17925.xls
mfg Jusuf
Bild

Betrifft: AW: stimmt nicht ganz...
von: HerbertH
Geschrieben am: 12.02.2005 19:19:03
hallo Jusuf,
ich habe es auf die Spaltenangabe deines ersten Beitrages ausgerichtet...
die Länge der linken Liste wird automatisch ermittelt...
ist ähnlich wie der Code von ransi...


Sub suchen()
Dim arr1, arr2
Dim lz&, lz1&, i&, z&, x As Byte, a As Byte
lz = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
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
             End If
         Next
     x = 0
  Next
Next
Application.ScreenUpdating = True
End Sub

     gruß Herbert
Bild

Betrifft: etwas schneller...
von: HerbertH
Geschrieben am: 12.02.2005 19:44:28
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 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
              ElseExit For
            End If
         Next
     x = 0
  Next
Next
Application.ScreenUpdating = True
MsgBox "Aktualisierungsdauer :  " & _
        Format(Timer - t, "#0.00") & " Sekunden"
End Sub

     gruß Herbert
Bild

Betrifft: AW: etwas schneller...
von: Jusuf
Geschrieben am: 12.02.2005 20:12:35
Hallo HerbertH,
vielen Dank für Hilfe. Es gefällt mir ganz gut. Das ist guter Makro zum Lernen!
mfg Jusuf
Bild

Betrifft: AW: Bereich vergleichen und markieren
von: ransi
Geschrieben am: 12.02.2005 16:29:17
hallo jusuf
schau mal hier:
https://www.herber.de/bbs/user/17929.xls
kann man bestimmt noch optimieren was die geschwindigkeit angeht.
ransi
Bild

Betrifft: AW: Bereich vergleichen und markieren
von: Jusuf
Geschrieben am: 12.02.2005 16:57:01
Hallo ransi,
so soll es funktionieren. Nur wie bringe ich, bitte, in Erfahrung wie Makro funktioniert.
mfg Jusuf
Bild

Betrifft: AW: Bereich vergleichen und markieren
von: ransi
Geschrieben am: 12.02.2005 17:12:57


      
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 

     Code eingefügt mit Syntaxhighlighter 3.0


Bild

Betrifft: AW: Bereich vergleichen und markieren
von: Jusuf
Geschrieben am: 12.02.2005 20:16:04
Hallo ransi,
vielen Dank. Es war ganz gute Hilfe.
mfg Jusuf
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bereich vergleichen und markieren"