AW: VBA: Spalten vergleichen
29.11.2017 09:38:15
Nepumuk
Hallo Erwin,
teste mal:
Option Explicit
Public Sub Vergleich_starten()
Dim objCell As Range
Dim objColumn As Range
Dim lngRow As Long
Dim lngColumn1 As Long
Dim lngColumn2 As Long
Dim lngColumn3 As Long
On Error Resume Next
Set objColumn = Application.InputBox( _
Prompt:="Bitte 1. Vergleichsspalte auswählen.", Type:=8)
If objColumn Is Nothing Then Exit Sub
lngColumn1 = objColumn.Columns(1).Column
Set objColumn = Application.InputBox( _
Prompt:="Bitte 2. Vergleichsspalte auswählen.", Type:=8)
If objColumn Is Nothing Then Exit Sub
lngColumn2 = objColumn.Columns(1).Column
Set objColumn = Application.InputBox( _
Prompt:="Bitte Ausgabespalte auswählen.", Type:=8)
If objColumn Is Nothing Then Exit Sub
lngColumn3 = objColumn.Columns(1).Column
On Error GoTo 0
Application.ScreenUpdating = False
For lngRow = 1 To Cells(Rows.Count, lngColumn1).End(xlUp).Row
Set objCell = Columns(lngColumn2).Find(What:=Cells(lngRow, lngColumn1).Value, _
LookIn:=xlValues, LookAt:=xlWhole)
If Not objCell Is Nothing Then Cells(lngRow, lngColumn3).Value = _
"in alter Liste in Zeile " & objCell.Row & " vorhanden"
Next
Set objCell = Nothing
Set objColumn = Nothing
Application.ScreenUpdating = True
End Sub
Public Sub Vergleich_löschen()
Dim objColumn As Range
Dim lngColumn As Long
On Error Resume Next
Set objColumn = Application.InputBox( _
Prompt:="Bitte Löschspalte auswählen.", Type:=8)
If objColumn Is Nothing Then Exit Sub
lngColumn = objColumn.Columns(1).Column
Range(Cells(2, lngColumn), Cells(Rows.Count, lngColumn)).ClearContents
Set objColumn = Nothing
End Sub