Zellinhalt mit Datenbank vergleichen und Zelle farbig markieren

[snb]

Verwende ein Range mit areas.

[schauan]

Hallo Ralf,

da könntest Du auch einen Bereichsnamen verwenden wo Du die Zellen hinterlegst und dann nimmst Du ZÄHLNWENN und die bedingte Formatierung.

[Rabe]

Hallo,

ich habe es nun so gelöst, würde aber gerne die ganzen Ifs ersetzen/zusammenfassen. Es sollen nur die eingefärbt werden, bei denen der Wert gegenüber dem in der Datenbank geändert wurde; ich bekomme es mit Arrays nicht hin:

Code:

Private Sub Zellen_vergleichen_färben()
  Dim arr1 As Variant
  Set objWs = ThisWorkbook.Worksheets("Eingabe_ELC")
 
  objWs.Range("I24") = VBA.Environ("Username")
  objWs.Range("K24") = Date
 
  strTyp = Range("E7").Value
 
  If objWs.Range("C6") = "Änderung" Then
     loZeile = Application.Match(strTyp, Sheets("Datenbank").Columns(3), 0)
  End If
 
  'Zusammenfassung der Zellen aus dem Eingabeblatt "Eingabe_ELC"
  arr1 = Array("I7", "K7", "E7", "C8", "E8", "G8", "C9", "E9", "G9", "I9", "C10", "E10", "G10", "I10", _
      "K10", "C12", "K9", "G12", "I12", "K12", "I8", "C14", "E14", "G14", "I14", "K14", "C15", "C16", _
      "E16", "G16", "I16", "C18", "E18", "G18", "I18", "K18", "C19", "C21", "E21", "C23", "E23", "G23", _
      "I23", "C24", "E24", "E19", "K1", "I24", "G21", "K24", "", "G19")
 
  With Sheets("Datenbank")
     'Zahl in Cells-Klammern ist die Spaltenzahl aus der Datenbank-Tabelle
     If .Cells(loZeile, 4).Value <> Range("C8").Value Then
        Range("C8").Interior.ColorIndex = 22
     Else
        Range("C8").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 5).Value <> Range("E8").Value Then
        Range("E8").Interior.ColorIndex = 22
     Else
        Range("E8").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 6).Value <> Range("G8").Value Then
        Range("G8").Interior.ColorIndex = 22
     Else
        Range("G8").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 7).Value <> Range("C9").Value Then
        Range("C9").Interior.ColorIndex = 22
     Else
        Range("C9").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 8).Value <> Range("E9").Value Then
        Range("E9").Interior.ColorIndex = 22
     Else
        Range("E9").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 9).Value <> Range("G9").Value Then
        Range("G9").Interior.ColorIndex = 22
     Else
        Range("G9").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 10).Value <> Range("I9").Value Then
        Range("I9").Interior.ColorIndex = 22
     Else
        Range("I9").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 11).Value <> Range("C10").Value Then
        Range("C10").Interior.ColorIndex = 22
     Else
        Range("C10").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 12).Value <> Range("E10").Value Then
        Range("E10").Interior.ColorIndex = 22
     Else
        Range("E10").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 13).Value <> Range("G10").Value Then
        Range("G10").Interior.ColorIndex = 22
     Else
        Range("G10").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 14).Value <> Range("I10").Value Then
        Range("I10").Interior.ColorIndex = 22
     Else
        Range("I10").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 15).Value <> Range("K10").Value Then
        Range("K10").Interior.ColorIndex = 22
     Else
        Range("K10").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 16).Value <> Range("C12").Value Then
        Range("C12").Interior.ColorIndex = 22
     Else
        Range("C12").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 17).Value <> Range("K9").Value Then
        Range("K9").Interior.ColorIndex = 22
     Else
        Range("K9").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 18).Value <> Range("G12").Value Then
        Range("G12").Interior.ColorIndex = 22
     Else
        Range("G12").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 19).Value <> Range("I12").Value Then
        Range("I12").Interior.ColorIndex = 22
     Else
        Range("I12").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 20).Value <> Range("K12").Value Then
        Range("K12").Interior.ColorIndex = 22
     Else
        Range("K12").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 21).Value <> Range("I8").Value Then
        Range("I8").Interior.ColorIndex = 22
     Else
        Range("I8").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 22).Value <> Range("C14").Value Then
        Range("C14").Interior.ColorIndex = 22
     Else
        Range("C14").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 23).Value <> Range("E14").Value Then
        Range("E14").Interior.ColorIndex = 22
     Else
        Range("E14").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 24).Value <> Range("G14").Value Then
        Range("G14").Interior.ColorIndex = 22
     Else
        Range("G14").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 25).Value <> Range("I14").Value Then
        Range("I14").Interior.ColorIndex = 22
     Else
        Range("I14").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 26).Value <> Range("K14").Value Then
        Range("K14").Interior.ColorIndex = 22
     Else
        Range("K14").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 27).Value <> Range("C15").Value Then
        Range("C15").Interior.ColorIndex = 22
     Else
        Range("C15").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 28).Value <> Range("C16").Value Then
        Range("C16").Interior.ColorIndex = 22
     Else
        Range("C16").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 29).Value <> Range("E16").Value Then
        Range("E16").Interior.ColorIndex = 22
     Else
        Range("E16").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 30).Value <> Range("G16").Value Then
        Range("G16").Interior.ColorIndex = 22
     Else
        Range("G16").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 31).Value <> Range("I16").Value Then
        Range("I16").Interior.ColorIndex = 22
     Else
        Range("I16").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 32).Value <> Range("C18").Value Then
        Range("C18").Interior.ColorIndex = 22
     Else
        Range("C18").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 33).Value <> Range("E18").Value Then
        Range("E18").Interior.ColorIndex = 22
     Else
        Range("E18").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 34).Value <> Range("G18").Value Then
        Range("G18").Interior.ColorIndex = 22
     Else
        Range("G18").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 35).Value <> Range("I18").Value Then
        Range("I18").Interior.ColorIndex = 22
     Else
        Range("I18").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 36).Value <> Range("K18").Value Then
        Range("K18").Interior.ColorIndex = 22
     Else
        Range("K18").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 37).Value <> Range("C19").Value Then
        Range("C19").Interior.ColorIndex = 22
     Else
        Range("C19").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 38).Value <> Range("C21").Value Then
        Range("C21").Interior.ColorIndex = 22
     Else
        Range("C21").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 39).Value <> Range("E21").Value Then
        Range("E21").Interior.ColorIndex = 22
     Else
        Range("E21").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 40).Value <> Range("C23").Value Then
        Range("C23").Interior.ColorIndex = 22
     Else
        Range("C23").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 41).Value <> Range("E23").Value Then
        Range("E23").Interior.ColorIndex = 22
     Else
        Range("E23").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 42).Value <> Range("G23").Value Then
        Range("G23").Interior.ColorIndex = 22
     Else
        Range("G23").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 43).Value <> Range("I23").Value Then
        Range("I23").Interior.ColorIndex = 22
     Else
        Range("I23").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 44).Value <> Range("C24").Value Then
        Range("C24").Interior.ColorIndex = 22
     Else
        Range("C24").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 45).Value <> Range("E24").Value Then
        Range("E24").Interior.ColorIndex = 22
     Else
        Range("E24").Interior.ColorIndex = 20
     End If
     If .Cells(loZeile, 46).Value <> Range("E19").Value Then
        Range("E19").Interior.ColorIndex = 22
     Else
        Range("E19").Interior.ColorIndex = 20
     End If
     '      .Cells(loZeile, 47) <> Range("K1")
     '      .Cells(loZeile, 48) <> Range("I24")
     If .Cells(loZeile, 49).Value <> Range("G21").Value Then
        Range("G21").Interior.ColorIndex = 22
     Else
        Range("G21").Interior.ColorIndex = 20
     End If
     '      .Cells(loZeile, 50) <> Range("K24")
     'Spalte 51 => Markierung: geändert
     If .Cells(loZeile, 52).Value <> Range("G19").Value Then
        Range("G19").Interior.ColorIndex = 22
     Else
        Range("G19").Interior.ColorIndex = 20
     End If
     
  End With
End Sub

Wie kann ich das zusammenfassen?

Ich habe bisher keine Erfahrung mit Arrays, so geht es jedenfalls nicht und auch nicht mit Dim arr1(53) as Variant:

Code:

Sub Makro1()
  Dim arr1 As Variant

  'Zusammenfassung der Zellen aus dem Eingabeblatt "Eingabe_ELC"
  arr1 = Array("I7", "K7", "E7", "C8", "E8", "G8", "C9", "E9", "G9", "I9", "C10", "E10", "G10", "I10", _
      "K10", "C12", "K9", "G12", "I12", "K12", "I8", "C14", "E14", "G14", "I14", "K14", "C15", "C16", _
      "E16", "G16", "I16", "C18", "E18", "G18", "I18", "K18", "C19", "C21", "E21", "C23", "E23", "G23", _
      "I23", "C24", "E24", "E19", "K1", "I24", "G21", "K24", "", "G19")
 
  With ActiveSheet        'Eingabeblatt "Eingabe_ELC"
'   'Nach vorne statt    "Zellen_vergleichen_färben"
'so geht es nicht
  For i = 1 To 52      '52 Spalten des Blattes "Datenbank"
     If arr1(i) <> "" Then
        If Sheets("Datenbank").Cells(loZeile, i) <> Range(arr1(i)).Value Then
           Range(arr1(i)).Interior.ColorIndex = 20
        End If
     End If
  Next i
  End With
End Sub

[schauan]

Hallo Ralf,

wenn Du ein Array mit der Array-Anweisung füllst, dann wird die Dimension darüber automatisch gesetzt. Anderes würde zu einem Fehler führen.
Dann ist noch die Frage, wo Du loLetzte her nimmst. Im Makro hast Du es nicht definiert.
Der letzte Fehler ist von mir. Ich hab da wohl wegen der Zelladressen was mit einem Array aus Zellen und einem Array aus der Array-Anweisung durcheinander gebracht. Das Array geht von 0 bis 51 und nicht von 1 bis 52
Also
For i = 0 to 51
und dann hier
Sheets("Datenbank").Cells(loZeile, i)
1 dazuzählen
Sheets("Datenbank").Cells(loZeile, i + 1)

[snb]

Code:

Sub M_snb()
  with ThisWorkbook.sheets("Eingabe_ELC")
     .Range("I24") = Environ("Username")
     .Range("K24") = Date

     set sn=.columns(3).find(.cells(7,5),,1).resize(,49)
      sp=Array([I7], [K7], [E7], [C8], [E8], [G8], [C9], [E9], [G9], [I9], [C10], [E10], [G10], [I10], [K10], [C12], [K9], [G12], [I12], [K12], [I8], [C14], [E14], [G14], [I14], [K14], [C15], [C16], [E16], [G16], [I16], [C18], [E18], [G18], [I18], [K18], [C19], [C21], [E21], [C23], [E23], [G23], [I23], [C24], [E24], [E19], [K1], [I24], [G21], [K24], "", [G19])

      for j=0 to ubound(sp)
        sn(1,j+1).interior.colorindex=22+2*(sp(j)=sn(1,j+1))
      next
  end with
End Sub

[Rabe]

Hi,

danke.
Ich versuche mal, die Code-Zeilen in einzelnen Blöcken zu erklären, wie ich das Makro verstehe:

Code:

Sub M_snb()
 with ThisWorkbook.sheets("Eingabe_ELC")
    .Range("I24") = Environ("Username")
    .Range("K24") = Date

die Code-Zeilen beziehen sich alle auf das Blatt "Eingabe_ELC", Zellen I24 und K24 werden beschrieben.

Code:

    set sn=.columns(3).find(.cells(7,5),,1).resize(,49)

sn ist der Bereich der Spalten im Blatt "Datenbank", deshalb gehört vermutlich vor die Punkte vor columns und cells dieser Teil: ThisWorkbook.sheets("Datenbank")

Code:

     sp=Array([I7], [K7], [E7], [C8], [E8], [G8], [C9], [E9], [G9], [I9], [C10], [E10], [G10], [I10], [K10], [C12], [K9], [G12], [I12], [K12], [I8], [C14], [E14], [G14], [I14], [K14], [C15], [C16], [E16], [G16], [I16], [C18], [E18], [G18], [I18], [K18], [C19], [C21], [E21], [C23], [E23], [G23], [I23], [C24], [E24], [E19], [K1], [I24], [G21], [K24], "", [G19])

die Variable sp wird gefüllt mit dem Array der blauen Eingabezellen in der "Eingabe_ELC".

Code:

     for j=0 to ubound(sp)
       sn(1,j+1).interior.colorindex=22+2*(sp(j)=sn(1,j+1))
     next
 end with
End Sub

alle einzelnen Spalten-Zellen der "Datenbank"-Zeile werden mit Farbe 24 eingefärbt, wenn Inhalt Eingabe-Zelle gleich Inhalt Datenbankzelle, ansonsten mit Farbe 22.

Da das anders rum sein soll (Eingabe-Zelle soll gefärbt werden) vermute ich, daß diese Zeile so heißen muß:
sp(j).interior.colorindex=22+2*(sp(j)=sn(1,j+1))

Habe ich das Makro richtig analysiert? Wie dimensioniere ich am besten die sn und sb?

[snb]

Ich hatte noch ein komma vergessen....

Code:

Sub M_snb()
  With ThisWorkbook.Sheets("Eingabe_ELC")
     .Range("I24") = Environ("Username")
     .Range("K24") = Date

      Set sn = Sheets("Datenbank").Columns(3).Find(.Cells(7, 5), , , 1).Resize(, 49)
      sp = Array([I7], [K7], [E7], [C8], [E8], [G8], [C9], [E9], [G9], [I9], [C10], [E10], [G10], [I10], [K10], [C12], [K9], [G12], [I12], [K12], [I8], [C14], [E14], [G14], [I14], [K14], [C15], [C16], [E16], [G16], [I16], [C18], [E18], [G18], [I18], [K18], [C19], [C21], [E21], [C23], [E23], [G23], [I23], [C24], [E24], [E19], [K1], [I24], [G21], [K24], "", [G19])

      For j = 0 To UBound(sp)
        sn(1, j + 1).Interior.ColorIndex = 22 + 2 * (sp(j) = sn(1, j + 1))
      Next
  End With
End Sub

In vba: false=0; True = -1