Zellinhalt mit Datenbank vergleichen und Zelle farbig markieren

[Rabe]

Hallo,

ich schreibe mit diesem Code diverse Zellen aus dem Blatt "Eingabe_ELC" in das Blatt "Datenbank" in eine definierte Zeile:

Option Explicit

Private Sub Speichern()
   'Speichern der Daten aus dem Blatt "Eingabe_ELC" in der Datenbank 
   'Zahl in Cells-Klammern ist die Spaltenzahl aus der Datenbank-Tabelle 
   With Sheets("Datenbank")
      .Cells(loZeile, 1) = Range("I7")
      .Cells(loZeile, 2) = Range("K7")
      .Cells(loZeile, 3) = Range("E7")
      .Cells(loZeile, 4) = Range("C8")
      .Cells(loZeile, 5) = Range("E8")
      .Cells(loZeile, 6) = Range("G8")
      .Cells(loZeile, 7) = Range("C9")
      .Cells(loZeile, 8) = Range("E9")
      .Cells(loZeile, 9) = Range("G9")
      .Cells(loZeile, 10) = Range("I9")
      .Cells(loZeile, 11) = Range("C10")
      .Cells(loZeile, 12) = Range("E10")
      .Cells(loZeile, 13) = Range("G10")
      .Cells(loZeile, 14) = Range("I10")
      .Cells(loZeile, 15) = Range("K10")
      .Cells(loZeile, 16) = Range("C12")
      .Cells(loZeile, 17) = Range("K9")
      .Cells(loZeile, 18) = Range("G12")
      .Cells(loZeile, 19) = Range("I12")
      .Cells(loZeile, 20) = Range("K12")
      .Cells(loZeile, 21) = Range("I8")
      .Cells(loZeile, 22) = Range("C14")
      .Cells(loZeile, 23) = Range("E14")
      .Cells(loZeile, 24) = Range("G14")
      .Cells(loZeile, 25) = Range("I14")
      .Cells(loZeile, 26) = Range("K14")
      .Cells(loZeile, 27) = Range("C15")
      .Cells(loZeile, 28) = Range("C16")
      .Cells(loZeile, 29) = Range("E16")
      .Cells(loZeile, 30) = Range("G16")
      .Cells(loZeile, 31) = Range("I16")
      .Cells(loZeile, 32) = Range("C18")
      .Cells(loZeile, 33) = Range("E18")
      .Cells(loZeile, 34) = Range("G18")
      .Cells(loZeile, 35) = Range("I18")
      .Cells(loZeile, 36) = Range("K18")
      .Cells(loZeile, 37) = Range("C19")
      .Cells(loZeile, 38) = Range("C21")
      .Cells(loZeile, 39) = Range("E21")
      .Cells(loZeile, 40) = Range("C23")
      .Cells(loZeile, 41) = Range("E23")
      .Cells(loZeile, 42) = Range("G23")
      .Cells(loZeile, 43) = Range("I23")
      .Cells(loZeile, 44) = Range("C24")
      .Cells(loZeile, 45) = Range("E24")
      .Cells(loZeile, 46) = Range("E19")
      .Cells(loZeile, 47) = Range("K1")
      .Cells(loZeile, 48) = Range("I24")
      .Cells(loZeile, 49) = Range("G21")
      .Cells(loZeile, 50) = Range("K24")
                                                'Spalte 51 = geändert? 
      .Cells(loZeile, 52) = Range("G19")
      
      'Schrift blau und fett einfärben 
      With .Range("A" & loZeile & ":AY" & loZeile).Font
         .Bold = True
         .Color = -4165632
         .TintAndShade = 0
      End With
   End With
   
   With Sheets("Aenderung")
      loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1) 
      loZeile = loLetzte + 1
      .Cells(loZeile, 1) = Range("E7")          'Gerät 
      .Cells(loZeile, 5) = Date                 'Änderungsdatum 
      .Cells(loZeile, 6) = Range("G21")         'Änderungsgrund 
      .Cells(loZeile, 7) = VBA.Environ("Username") 'Freigeber 
   End With
   
End Sub

Nun möchte ich in einem anderem Sub die Inhalte der Eingabe-Zellen mit dem der Datenbankzeile vergleichen und bei Unterschieden die Eingabezellen in Koralle färben.
Dann speichere ich das Blatt mit einem anderen Makro in einer extra Datei ab und danach sollen in der Ursprungsdatei alle Zellen wieder auf helltürkis zurückgesetzt werden.

Die Zellen sind aus dem obigen Code ersichtlich (Spalte 1-3 ist nicht notwendig).
Mit vielen If-Schleifen ist das sicher machbar, aber wie kann ich das Vergleichen und Umfärben am einfachsten machen?


Farbe

	A	B	C	D	E	F	G	H
1	Farbe	Index	R	G	B	Bezeichnung	FarbHex	FarbIndex
2		20	204	255	255	Helles Türkis	&H00FFFFCC&	16777164
3		22	255	128	128	Koralle	&H008080FF&	8421631

Füllfarben und Muster
Zelle	Rot	Grün	Blau	Color	Muster	Farbe
A2	204	255	255	16777164
A3	255	128	128	8421631

Zellen mit Füllfarbe automatisch werden nicht dargestellt

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 19.08 einschl. 64 Bit

[snb]

Vorschlag als Alternative:

with Sheets("Datenbank")
     .Cells(loZeile, 1).resize(,52) = array(.Range("I7"),.Range("K7"),.Range("E7"),.Range("C8"),.Range("E8"),.Range("G8"))
end with

[Rabe]

Hi snb,

ok, das ist die Alternative für das Speichern der Zellinhalte in der Datenbank (ohne . bei Range). Danke!
Das löst jedoch nicht die Frage.

Ich habe den Speichercode nur gezeigt, damit sichtbar ist, welcher Zellinhalt in "Eingabe_ELC" (Range) mit welchem Zellinhalt in "Datenbank" (Cells...) verglichen werden soll.
Dann will ich bei Veränderungen die Zelle in "Eingabe_ELC" (Range) einfärben uind später wieder rückfärben.

So geht es ja, aber das ist mir für 50 Zellen zu viel Tipparbeit.

Private Sub Zellen_vergleichen_färben()
   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
   
   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
      'so geht es, aber wie kann ich das für die folgende lange Liste von Zellen zusammenfassen? 
      
      '... 
'      .Cells(loZeile, 4) <> Range("C8") 
'      .Cells(loZeile, 5) <> Range("E8") 
'      .Cells(loZeile, 6) <> Range("G8") 
'      .Cells(loZeile, 7) <> Range("C9") 
'      .Cells(loZeile, 8) <> Range("E9") 
'      .Cells(loZeile, 9) <> Range("G9") 
'      .Cells(loZeile, 10) <> Range("I9") 
'      .Cells(loZeile, 11) <> Range("C10") 
'      .Cells(loZeile, 12) <> Range("E10") 
'      .Cells(loZeile, 13) <> Range("G10") 
'      .Cells(loZeile, 14) <> Range("I10") 
'      .Cells(loZeile, 15) <> Range("K10") 
'      .Cells(loZeile, 16) <> Range("C12") 
'      .Cells(loZeile, 17) <> Range("K9") 
'      .Cells(loZeile, 18) <> Range("G12") 
'      .Cells(loZeile, 19) <> Range("I12") 
'      .Cells(loZeile, 20) <> Range("K12") 
'      .Cells(loZeile, 21) <> Range("I8") 
'      .Cells(loZeile, 22) <> Range("C14") 
'      .Cells(loZeile, 23) <> Range("E14") 
'      .Cells(loZeile, 24) <> Range("G14") 
'      .Cells(loZeile, 25) <> Range("I14") 
'      .Cells(loZeile, 26) <> Range("K14") 
'      .Cells(loZeile, 27) <> Range("C15") 
'      .Cells(loZeile, 28) <> Range("C16") 
'      .Cells(loZeile, 29) <> Range("E16") 
'      .Cells(loZeile, 30) <> Range("G16") 
'      .Cells(loZeile, 31) <> Range("I16") 
'      .Cells(loZeile, 32) <> Range("C18") 
'      .Cells(loZeile, 33) <> Range("E18") 
'      .Cells(loZeile, 34) <> Range("G18") 
'      .Cells(loZeile, 35) <> Range("I18") 
'      .Cells(loZeile, 36) <> Range("K18") 
'      .Cells(loZeile, 37) <> Range("C19") 
'      .Cells(loZeile, 38) <> Range("C21") 
'      .Cells(loZeile, 39) <> Range("E21") 
'      .Cells(loZeile, 40) <> Range("C23") 
'      .Cells(loZeile, 41) <> Range("E23") 
'      .Cells(loZeile, 42) <> Range("G23") 
'      .Cells(loZeile, 43) <> Range("I23") 
'      .Cells(loZeile, 44) <> Range("C24") 
'      .Cells(loZeile, 45) <> Range("E24") 
'      .Cells(loZeile, 46) <> Range("E19") 
'      .Cells(loZeile, 47) <> Range("K1") 
''      .Cells(loZeile, 48) <> Range("I24") 
'      .Cells(loZeile, 49) <> Range("G21") 
''      .Cells(loZeile, 50) <> Range("K24") 
'      'Spalte 51 = geändert 
'      .Cells(loZeile, 52) <> Range("G19") 
   End With
End Sub

[snb]

- Verwende immer Arrays

- Verwende immer eine korrekte Referenzierung: .Range

- und lade immer eine Beispieldatei hoch

[Rabe]

Hi,

- Verwende immer Arrays
- Verwende immer eine korrekte Referenzierung: .Range

- das will ich ja, weiß aber nicht wie, darum frage ich.
- bei Deinem Code beziehen sich aber sowohl die .Cells als auch die .Range auf die "Datenbank" und das ist falsch, denn die Range-Zellen sollen sich auf "Eingabe_ELC" beziehen:

Code:

with Sheets("Datenbank")
     .Cells(loZeile, 1).resize(,52) = array(.Range("I7"),.Range("K7"),.Range("E7"),.Range("C8"),.Range("E8"),.Range("G8"))
end with

Dann müßte ich bei jedem Range schreiben 'Sheets("Eingabe_ELC").Range', deswegen lasse ich den . weg.

[Gast 123]

Hallo Ralf

ich habe mir die Liste mal angeschaut und sehe eın bestimmtes System.  Oft werden die Spalten C-K verglichen, leider nicht mit fortlaufenden Zeilen. Trotzdem kann man das mit GoSub Unterprogramm auswerten.  Die Einzelzellen Zeile 9 usw. müssen aber extra ausgewertet werden.  

Ich vergleiche nicht über Range sondern Cells, da kann ich mit Stepo 2 arbeiten, jede 2. Spalte.  Die zu vergleişchenden Zeilen vRow und loZeıle musst du vorher festlegen.  Ob die Idee gut ist weiss ich nicht?  Vielleicht hilft es dir weiter. 

mfg  Gast 123

Code:

Sub GoSub_Test()
Dim loZeile As Integer
Dim vRow As Integer, s As Integer
   'Vergleich über Unterprogramm  (mit Return)
   vRow = 10:  loZeile = 4:   GoSub Vsp
   vRow = 12:  loZeile = 16:  GoSub Vsp
   vRow = 14:  loZeile = 22:  GoSub Vsp

   'Hier noch Einzelzellen Prüfen !!
Exit Sub

Vsp:  'Verify Spalted C-K  (über vRow)
   For s = 3 To 11 Step 2  'Spalte C,E,G,I,K
      If .Cells(loZeile, 4) <> Cells(vRow, s) Then
         'Hier Zelle markieren einfügen
      End If
      loZeile = loZeile + 1
   Next s
   Return
End Sub

[Rabe]

Hallo,

hier nun mal eine schon früher gezeigte Datei zum ausprobieren:

  Technische Daten_ELC - 2017-07-13.xlsb (Größe: 102,67 KB / Downloads: 5)

Vielleicht gibt es ja noch eine andere Idee als meine, den Inhalt der hellblau markierten Zellen mit den entsprechenden Spalten der Datenbank zu vergleichen und in Koralle einzufärben und nach dem Abspeichern wieder rückzufärben.

Anmerkung:
Eine Diskussion wegen den verbundenen Zellen hatten wir schon, sie erübrigt sich also diesmal. Wenn es deswegen keine Lösung gibt, werde ich in den sauren Apfel beißen und es mit vielen IF-Schleifen machen.


Wenn ich in einem Range mit "Union" viele Zellen (die nicht zusammenhängen) zusammenfügen will, kann ich dies ja auch komplett auf ein Mal mit hellblau einfärben?
Geht das so?
raBereich = Union(Range("A1"), Range("B3"), ...)
raBereich.Interior.ColorIndex = 20

[schauan]

Hallo Ralf,

mal wegen der ursprünglichen Frage:

Code:

Sub Makro1()
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
For i = 1 To 52
If arr1(i) <> "" Then .Cells(loZeile, 1) = Range(arr(i))
Next
End With
End Sub

Wenn bei der 51 auch noch eine Verarbeitung rein kommt, brauchst Du die Fallunterscheidung nicht mehr.
Du könntest alternativ auch mit einer Adresstabelle arbeiten:

Tabellenblattname: Tabelle1

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ
1	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

von schauan

Hab ich übrigens gemacht, um mir die Schreibarbeit zu sparen
Erst in Deinem Code loletzte durch 1 ersezt und Range( und ) rausgenommen und dann einen String gebildet:
Sub makro2()
For i = 1 To 52
str1 = str1 & """" & Cells(1, i) & ""","
Next
Debug.Print str1
End Sub

[Rabe]

Hi André,
Danke, wenn ich morgen wieder am PC sitze, werde ich es testen.

[Rabe]

Hi André,

mal wegen der ursprünglichen Frage:

Du könntest alternativ auch mit einer Adresstabelle arbeiten:

Wenn ich es richtig verstehe, dann ersetzt dieser Code meinen Code im ersten Beitrag:

Sub Makro1()

  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")       'Zusammenfassung der Zellen aus dem Eingabeblatt "Eingabe_ELC" 

  With ActiveSheet        'Eingabeblatt "Eingabe_ELC" 

     For i = 1 To 52      '52 Spalten des Blattes "Datenbank" 

        'Wenn der Zellbegriff im Array ungleich leer ist, übertrage die Werte der Array-Zelle in die Datenbankzeile in Spalte 1 

        'statt der 1 sollte das i stehen! 

        If arr1(i) <> "" Then Sheets("Datenbank").Cells(loZeile, 1) = Range(arr(i))

     Next i

  End With

End Sub

Mit dem Array habe ich also alle Zellen beieinander und kann sie gemeinsam färben.

Aber nun nochmal meine ursprüngliche Frage in diesem Thema:
Wie kann ich die einzelnen Felder des Arrays mit dem jeweiligen Spalten-Inhalt vergleichen und das einzelne Feld bei fehlender Übereinstimmung anders einfärben?