Spalten vergleichen - VBA | HERBERS Excel Forum

Sub Vergleich() Dim A As Range, B As Range, C As Range Dim i%, y%, z% Set A = Columns(1) Set B = Columns(2) Set C = Columns(3) i = 1: y = 1: z = 1 Do Until IsEmpty(A.Cells(i)) Do Until IsEmpty(B.Cells(y)) If A.Cells(i) = B.Cells(y) Then C.Cells(z) = A.Cells(i) z = z + 1: y = 1 Exit Do End If y = y + 1 Loop i = i + 1: y = 1 Loop End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Wolfgang,


Sub Compare()
Dim rng As Range
Dim iRngALastIndex As Integer
Dim iRngBLastIndex As Integer
Dim iResultCounter As Integer
Dim compareValue As Variant
Dim i As Integer
Dim y As Integer
Dim b As Boolean
' Bereiche von Saplten A und B festlegen
Set rng = Me.Range("A65536")
iRngALastIndex = rng.End(xlUp).Row
Set rng = Me.Range("B65536")
iRngBLastIndex = rng.End(xlUp).Row
' Spalte A mit B vergleichen
For i = 1 To iRngALastIndex
compareValue = Me.Cells(i, 1).Value
b = False
For y = 1 To iRngBLastIndex
If Me.Cells(y, 2).Value = compareValue Then
b = True
Exit For
End If
Next
If Not b Then
iResultCounter = iResultCounter + 1
Me.Cells(iResultCounter, 3).Value = compareValue
End If
Next
' Spalte B mit A vergleichen
For i = 1 To iRngBLastIndex
compareValue = Me.Cells(i, 2).Value
b = False
For y = 1 To iRngALastIndex
If Me.Cells(y, 1) = compareValue Then
b = True
Exit For
End If
Next
If Not b Then
iResultCounter = iResultCounter + 1
Me.Cells(iResultCounter, 3).Value = compareValue
End If
Next
End Sub

Das wäre das, was du möchtest.
Gruss Alex

Sub VergleichII() Dim A As Range, B As Range, C As Range Dim i%, z% Set A = Columns(1) Set B = Columns(2) Set C = Columns(3) i = 1: z = 1 Do Until IsEmpty(A.Cells(i)) If Application.WorksheetFunction.CountIf(B, A.Cells(i)) = 0 Then C.Cells(z) = A.Cells(i) z = z + 1 End If i = i + 1 Loop i = 1 Do Until IsEmpty(B.Cells(i)) If Application.WorksheetFunction.CountIf(A, B.Cells(i)) = 0 Then C.Cells(z) = B.Cells(i) z = z + 1 End If i = i + 1 Loop End Sub

Hallo Wolfgang,
wenn es um viele Zellen geht, die Du vergleichen möchtest, empfehle ich Dir den nachstehenden Code, er ist um einiges schneller als die bisher geposteten Lösungen:

Sub Einzelne_auflisten()
Dim ALetzte As Long, BLetzte As Long, iCounter As Long, xCounter As Long
Dim xZelle As Range
ALetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(-4162).Row, Rows.Count)
BLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(-4162).Row, Rows.Count)
For iCounter = 1 To ALetzte
    Set xZelle = Columns(2).Find(what:=Cells(iCounter, 1), Lookat:=xlWhole)
    If Not xZelle Is Nothing Then
        xCounter = xCounter + 1
        Cells(xCounter, 3) = Cells(iCounter, 1)
    End If
Next iCounter
For iCounter = 1 To BLetzte
    Set xZelle = Columns(1).Find(what:=Cells(iCounter, 2), Lookat:=xlWhole)
    If Not xZelle Is Nothing Then
        xCounter = xCounter + 1
        Cells(xCounter, 3) = Cells(iCounter, 2)
    End If
Next iCounter
End Sub

Gruß aus Leipzig
P@ulchen
www.excel-werkstatt.de

Beliebteste Forumthreads (12 Monate)

Spalten vergleichen - VBA

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread