ich komme mir echt zu bloed vor. Ich habe von einem von Euch einen schoenen Code bekommen der genau das macht was ich will. Der Code soll zwei sheets miteinander vergleichen und dann die Felder die gleich sind farblich (gruen) markieren.
Leider genuegt mir das nicht. Ich habe drei weitere Fragestellungen zu meinem Code:
1. Ich will, dass ein CommandButton den ganzen Kram ausloest. Der CommandButton ist im Sheet3. Dies macht er auch, markiert aber leider die Felder in dem CommandButton Sheet3. Das ist schlecht. Er soll doch die Felder im sheet1 markieren.
2. Es sollen nur Nummern mit einander verglichen werden. Die Ueberschrift soll nicht gruen markiert werden. Diese ist naemlich auch in beiden sheets gleich. Bei dem jetzigen Zustand des VBA Codes werden naemlich auch die Ueberschriften eingefaerbt. (Riecht nach String und nicht nach Text)
3. Es sollen nicht nur die Felder welche in Sheet1 gleich sind markiert werden, sondern es soll die Reihe in der beide Nummern identisch sind markiert werden. Nicht die komplette Reihe, sondern nur bis Spalte I.
Bitte markiert erst die Frage als beantwortet, wenn alle drei Punkte beantwortet sind. Falls ihr mit meinem Kauderwelsch auch nicht klar kommt, so bitte auch die Frage nicht als beantwortet zu sehen vielleicht kann jemand anderes damit etwas anfangen.
Vielen Dank im Voraus
Gnilk
Hier ist der Link zur Beispieldatei:
https://www.herber.de/bbs/user/26754.xls
Hier ist der alte Code:
Private Sub CommandButton1_Click()
Dim objCell As Range
Dim strAddress As String
Dim lngRow As Long
With Worksheets("sheet1")
For lngRow = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Trim$(.Cells(lngRow, 1).Text) <> "" And _
Trim$(.Cells(lngRow, 2).Text) <> "" Then
Set objCell = Worksheets("Sheet2").Columns(1). _
Find(What:=.Cells(lngRow, 1).Text, _
LookIn:=xlFormulas, LookAt:=xlWhole)
If ObjPtr(objCell) <> 0 Then
strAddress = objCell.Address
Do
If Worksheets("Sheet2").Cells(objCell.Row, 2).Text = _
.Cells(lngRow, 2).Text Then _
Range(Cells(lngRow, 1), Cells(lngRow, 2)). _
Interior.ColorIndex = 4
Set objCell = Worksheets("Sheet2").Columns(1). _
FindNext(objCell)
Loop While ObjPtr(objCell) <> 0 And _
objCell.Address <> strAddress
End If
End If
Next
End With
End Sub