AW: Hilfe für Vergleichen - einfügen
12.06.2015 20:31:27
Sepp
Hallo Peter,
per VBA.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub compare()
Dim varAll As Variant, varChoosen As Variant, varError() As Variant, varIdentic() As Variant
Dim lngN As Long, lngI As Long, lngE As Long
Dim vntR As Variant
With Sheets("Tabelle1_alle")
varAll = .Range("A2:A" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row))
End With
With Sheets("Tabelle2_gewählte")
varChoosen = .Range("A2:B" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row))
End With
Sheets("Tabelle4_Fehler").Range("A2:B1000") = ""
Sheets("Tabelle3_identisch").Range("A2:B1000") = ""
For lngN = 1 To UBound(varChoosen, 1)
If varChoosen(lngN, 1) <> "" Then
vntR = Application.Match(varChoosen(lngN, 1), varAll, 0)
If IsError(vntR) Or varChoosen(lngN, 2) = "" Then
Redim Preserve varError(lngE)
varError(lngE) = Array(varChoosen(lngN, 1), varChoosen(lngN, 2))
lngE = lngE + 1
End If
If Not IsError(vntR) And varChoosen(lngN, 2) <> "" Then
Redim Preserve varIdentic(lngI)
varIdentic(lngI) = Array(varChoosen(lngN, 1), varChoosen(lngN, 2))
lngI = lngI + 1
End If
End If
Next
If lngI > 0 Then _
Sheets("Tabelle4_Fehler").Range("A2").Resize(UBound(varError) + 1, 2) = _
Application.Transpose(Application.Transpose(varError))
If lngE > 0 Then _
Sheets("Tabelle3_identisch").Range("A2").Resize(UBound(varIdentic, 1) + 1, 2) = _
Application.Transpose(Application.Transpose(varIdentic))
End Sub
Gruß Sepp