Makro zum Einfärben

Question

Hallo Leute

Ich hab hier ein Makro aus diesem Forum und komme einfach nicht weiter.

Sub testeinfärben()

Dim rgZelle As Range
For Each rgZelle In Range(Cells(1, 1), Cells(2, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column))

If rgZelle.Value = Sheets("Tabelle1").Range("A1").Value Then
Sheets("Tabelle2").Cells(1, rgZelle.Column).Interior.ColorIndex = 4 ' grün
End If
Next

End Sub

A1 Wert von Tabelle 1 wird in Tabelle 2 nur in ganzer Zeile 1 gesucht und dann eingefärbt.
Wie kann man jetzt weitere Werte suchen?
Also
A2 Wert von Tabelle1 in Tabelle 2 nur in Zeile 2 suchen und einfärben usw...
Habe versucht das ganze Makro zu kopieren und die Werte zu ersetzten/anzupassen aber ich bekomms nich hin.
Vielleicht hat jemand einen Tipp.

Answer 1

Hallo Community ^^

Ein Beispiel,ohne Doppelte zu berücksichtigen

Gruß Nighty

Sub WertSuche()
Dim Rziel As Variant
Dim RQuelle As Object, Suche As Object
Dim Rzeilen As Long
Set RQuelle = ActiveSheet.UsedRange
Rziel = Worksheets(2).Range("A1:A" & Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row)
For Rzeilen = 1 To UBound(Rziel)
Set Suche = RQuelle.Find(Rziel(Rzeilen, 1))
If Not Suche Is Nothing Then
If Suche.Row = Rzeilen Then ActiveSheet.Cells(Suche.Row, Suche.Column).Interior.ColorIndex = 3
End If
Next Rzeilen
End Sub

Answer 2

Hallo nighty__

ich versteh dein Makro leider nicht.

Ich will eigentlich nur einen weiteren Wert aus Tab1 (A2)
in Tab2 in Zeile 2 finden und einfärben.
Mit diesem Makro geht nur 1 Wert aus Tab1


Sub testeinfärben()

Dim rgZelle As Range
For Each rgZelle In Range(Cells(1, 1), Cells(2, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column))

If rgZelle.Value = Sheets("Tabelle1").Range("A1").Value Then
Sheets("Tabelle2").Cells(1, rgZelle.Column).Interior.ColorIndex = 4 ' grün
End If
Next

End Sub

Answer 3

Hi nighty__

Ich konnte es jetzt so lösen wahrscheindlich nicht perfekt aber es läuft

Sub testeinfärben()
Dim rgZelle2 As Range
Dim rgZelle As Range
For Each rgZelle In Range(Cells(1, 1), Cells(1, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column))

For Each rgZelle2 In Range(Cells(2, 2), Cells(2, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column))

If rgZelle.Value = Sheets("Tabelle1").Range("A1").Value Then
Sheets("Tabelle2").Cells(1, rgZelle.Column).Interior.ColorIndex = 4 ' grün

ElseIf rgZelle2.Value = Sheets("Tabelle1").Range("A2").Value Then
Sheets("Tabelle2").Cells(2, rgZelle2.Column).Interior.ColorIndex = 28 ' grün



End If
Next
Next

End Sub

Answer 4

Hallo Kammile19 ^^

Fein!
Ist doch schonmal ein Anfang!

Gruß Nighty

Answer 5

Hallo Kammile19 ^^

Ein versuch der Erklärung!
Das vorgeschlagende Makro ist um ein vielfaches schneller!

Gruß Nighty

Sub WertSuche()
'Variablen Bestimmung
Dim Rziel As Variant
Dim RQuelle As Object, Suche As Object
Dim Rzeilen As Long
'Suchbereich
Set RQuelle = ActiveSheet.UsedRange
'Suchbegriffe parallel zum Suchbereich
Rziel = Worksheets(2).Range("A1:A" & Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row)
'Schleife um die Suchbegriffe
For Rzeilen = 1 To UBound(Rziel)
'Nutzung der Findmethode im Suchbereich
Set Suche = RQuelle.Find(Rziel(Rzeilen, 1))
'Abfrage auf Fund
If Not Suche Is Nothing Then
'Abfrage der Prallelität,bei übereinstimmung färbung der Zelle
If Suche.Row = Rzeilen Then ActiveSheet.Cells(Suche.Row, Suche.Column).Interior.ColorIndex = 3
End If
Next Rzeilen
End Sub