Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1592to1596
1592to1596
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA: Spalten vergleichen

Forumthread: VBA: Spalten vergleichen

VBA: Spalten vergleichen
29.11.2017 08:01:15
Erwin
Guten Morgen,
ich möchte zwei Spalten vergleichen und in der 3. Spalte sollen die gleichen Werte mit Zeilennummer ausgegeben werden.
Dazu habe ich ein kleines Programm gefunden, welches aber starr auf die Spalten A (alte Liste), C (neue Liste) und E (Vergleichsergebnis) fixiert ist.
Ziel ist es über 3 Inputboxen das Programm flexibler zu gestalten, sodass ich z. B. auch die Spalten D mit G vergleichen - und in J das Vergleichsergebnis ausgeben kann.
Außerdem frage ich mich, warum der Code nur läuft, wenn "On Error Resume Next" im Code steht.
Hier meine Datei: https://www.herber.de/bbs/user/117979.xlsm
Wer kann mir bitte die Anpassungen vornehmen?
Danke schon mal - Erwin
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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

Anzeige
VBA: Spalten vergleichen
29.11.2017 10:08:26
Erwin
Hallo Nepumuk,
ich bin immer wieder erstaunt, wie ihr Experten das macht, einfach super.
Ich hätte jetzt noch eine Nachfrage: Wenn es jetzt keine Übereinstimmung in den Spalten gibt, kann man am Ende evtl. noch zur Sicherheit eine MsgBox erscheinen lassen (z. B. keine gleichen Werte gefunden)?
Vielen herzlichen Dank für deine Mühe.
Grüße - Erwin
Anzeige
AW: VBA: Spalten vergleichen
29.11.2017 10:30:08
Nepumuk
Hallo Erwin,
so ok?
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
Dim blnFound As Boolean
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"
blnFound = True
End If
Next
Set objCell = Nothing
Set objColumn = Nothing
Application.ScreenUpdating = True
If Not blnFound Then _
Call MsgBox("Keine gleichen Werte gefunden.", vbInformation, "Information")
End Sub

Gruß
Nepumuk
Anzeige
AW: VBA: Spalten vergleichen
29.11.2017 11:00:28
Erwin
Hallo Nepumuk,
ja, genau SO OK !
Nochmals vielen Dank für's machen.
Grüße - Erwin
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige