1
VBA Zellen vergleichen und bei gleichen Werten Zeile farbig markieren
Hallo, ich habe folgendes Makro geschrieben. Hatte es leicht abgeändert an anderer Stelle laufen, dort funktioniert es einwandfrei (siehe unten).
Es soll zwei Zellen vergleichen (Spalte 1 und Spalte 18) und bei gleichen Werten soll er die gesamte Zeile blau einfärben.
Er färbt mir aber nur die erste nicht benutzte Zeile ein, obwohl einige Werte in der Tabelle übereinstimmen.
Es soll zwei Zellen vergleichen (Spalte 1 und Spalte 18) und bei gleichen Werten soll er die gesamte Zeile blau einfärben.
Er färbt mir aber nur die erste nicht benutzte Zeile ein, obwohl einige Werte in der Tabelle übereinstimmen.
Public Sub Doppelt_loeschen()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim wksA As Worksheet
Set wksA = Worksheets("Kunden")
Application.ScreenUpdating = False
lngLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row + 1, 65536)
For lngZeile = lngLetzte To 1 Step -1
If wksA.Cells(lngZeile, 18) = wksA.Cells(lngZeile, 1) Then
wksA.Cells(lngZeile, 18).EntireRow.Interior.ColorIndex = 33
End If
Next
Application.ScreenUpdating = True
End Sub
Hat jemand eine Idee?
Mein Anderes Makro, dass funktioniert sieht so aus. Hier shaut er in die Spalte 15, wenn keine werte eingetragen sind löscht er die gesamte Zeile.
Public Sub NULL_ers2()
Dim lngLetzte As Long
Dim lngZeile As Long
Application.ScreenUpdating = False
lngLetzte = IIf(IsEmpty(Range("O65536")), Range("O65536").End(xlUp).Row + 1, 65536)
For lngZeile = lngLetzte To 1 Step -1
If Cells(lngZeile, 15) = "" Then
Cells(lngZeile, 15).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Kommentar vom Moderator Biber am 12.08.2009 um 10:13:57 Uhr
Code-Tags im Beitrag und im Lösungs-Kommentar gesetzt und Beitrag von "Entwicklung" nach "Excel" verschoben.
Content-ID: 122555
Url: https://administrator.de/contentid/122555
Ausgedruckt am: 26.11.2024 um 11:11 Uhr
1 Kommentar
Habe es gerade selber hin bekommen. Hier die Lösung:
("text" hat gefehlt) erkennt wohl den Inhalt der Zellen nicht richtig.
("text" hat gefehlt) erkennt wohl den Inhalt der Zellen nicht richtig.
Public Sub Doppelt_loeschen()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim wksA As Worksheet
Set wksA = Worksheets("Kunden")
Application.ScreenUpdating = False
lngLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row + 1, 65536)
For lngZeile = lngLetzte To 1 Step -1
If wksA.Cells(lngZeile, 18) .text= wksA.Cells(lngZeile, 1).text Then
wksA.Cells(lngZeile, 18).EntireRow.Interior.ColorIndex = 33
End If
Next
Application.ScreenUpdating = True
End Sub
