Daten vergleich

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten vergleich

28.04.2007 00:10:00

Uduuh

AW: Daten vergleich

28.04.2007 07:40:00

Möschel

AW: Daten vergleich

28.04.2007 08:06:20

Möschel

AW: Daten vergleich

28.04.2007 19:52:00

nighty007

Sub Vergleich() Dim BooDrin As Boolean Dim lngLastRow1 As Long, lngLastRow2 As Long, lngCounter As Long Dim rngFind As Range Dim varFirstAddress As Variant lngLastRow1 = Worksheets("Tabelle1").Cells(Rows.Count, 6).End(xlUp).Row lngLastRow2 = Worksheets("Tabelle2").Cells(Rows.Count, 2).End(xlUp).Row Application.ScreenUpdating = False For lngCounter = 1 To lngLastRow1 BooDrin = False With Worksheets("Tabelle2").Range("B1:B" & lngLastRow2) Set rngFind = .Find(Worksheets("Tabelle1").Cells(lngCounter, 6), LookIn:=xlValues) If Not rngFind Is Nothing Then varFirstAddress = rngFind.Address Do Worksheets("Tabelle1").Cells(lngCounter, 7) = "Wahr" BooDrin = True Exit Do Loop While Not rngFind Is Nothing And rngFind.Address varFirstAddress End If If BooDrin = False Then Worksheets("Tabelle1").Cells(lngCounter, 7) = "Falsch" End With Next lngCounter Application.ScreenUpdating = True End Sub

hi dieter :-)
wie gewünscht
gruss nighty
verbundene zellen sind nicht erlaubt
blattschutz waere zu ergaenzen
Option Explicit

Sub vergleich() Dim w1x As Integer Dim w2x As Integer Dim w3x As Integer Dim zaehler1 As Integer Dim w1y As Long Dim w2y As Long Dim w3y As Long Dim zaehler0 As Long Dim suche1 As Range Dim suche2 As Range w1x = 3 w1y = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row w2x = 3 w2y = Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row If w1y > w2y Then w3y = w1y Else w3y = w2y End If ReDim excel1(w3y, w1x) As Variant ReDim excel2(w3y, w2x) As Variant Sheets(2).Select excel2() = Range(Cells(1, 1), Cells(w3y, w2x)) Sheets(1).Select excel1() = Range(Cells(1, 1), Cells(w3y, w1x)) For zaehler0 = 2 To w3y Set suche1 = Sheets(2).Range("A2:A" & w3y).Find(excel1(zaehler0, 1), Lookat:=xlWhole) Set suche2 = Sheets(1).Range("A2:A" & w3y).Find(excel2(zaehler0, 1), Lookat:=xlWhole) If Not suche1 Is Nothing Then If excel1(zaehler0, 1) = excel2(suche1.Row, 1) _ And excel1(zaehler0, 2) = excel2(suche1.Row, 2) And _ excel1(zaehler0, 3) = excel2(suche1.Row, 3) And excel1(zaehler0, 1) "" Then Sheets(2).Rows(suche1.Row & ":" & suche1.Row).Interior.ColorIndex = 6 End If End If If Not suche2 Is Nothing Then If excel2(zaehler0, 1) = excel1(suche2.Row, 1) _ And excel2(zaehler0, 2) = excel1(suche2.Row, 2) And _ excel2(zaehler0, 3) = excel1(suche2.Row, 3) And excel2(zaehler0, 1) "" Then Sheets(1).Rows(suche2.Row & ":" & suche2.Row).Interior.ColorIndex = 6 End If End If Next zaehler0 End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread