VBA-Code: Vergleich von zwei Spalten
23.09.2021 11:20:19
zwei
ich habe ein kleines Problem mit meinem VBA-Code für Excel.
Ich bin recht neu in VBA und habe mir den folgenden Code aus Google gezogen und ihn minimal angepasst.
Ich möchte mit dem Code einen Bereich einer Spalte markieren und mit einem zweiten Spaltenbereich vergleichen, den ich ebenfalls mit dem VBA-Code markiere.
Bei gleichen Werten soll in einen dritten Spaltenbereich, der auf dem gleichen Tabellenblatt wie der erste Spaltenbereich ist, in der gleichen Zeile wie Spalte 1 "einblenden" übertragen werden. (Den dritten Spaltenbereich möchte ich auch per VBA markieren)
Das markieren der der drei Bereiche funktioniert und das Vergleich der Werte auch.
Das Problem ist das ich mit Offset die Werte auch übertragen bekomme aber ich nicht jedes mal in den Code gehen möchte und das Offset ändern möchte, wenn ich die Werte in einer anderen Spalte möchte.
Ich hoffe ihr versteht ungefähr was ich euch sagen möchte, wenn ihr irgendwelche Fragen habt einfach nachfragen.
Ich weiß schon das der Fehler hier liegt, aber ich weiß nicht was ich anders machen muss:
For Each xRgF1 In xRgC1
For Each xRgF2 In xRgC2
If xRgF1.Value = xRgF2.Value Then xRgF3 = "einblenden"
Next xRgF2
Next xRgF1
Grüße
Dario
PS: der letzte Teil markiert nur die Werte, welche identisch sind in Spalte 2.
Sub ausfüllen()
Dim xRg, xRgC1, xRgC2, xRgC3, xRgF1, xRgF2, xRgF3 As Range
Dim xIntSR, xIntER, xIntSC, xIntEC As Integer
On Error Resume Next
SRg:
Set xRgC1 = Application.InputBox("Select first column comparison:", "Kutools for Excel", , , , , , 8)
If xRgC1 Is Nothing Then Exit Sub
If xRgC1.Columns.Count 1 Then
MsgBox "Please select single column"
GoTo SRg
End If
SsRg:
Set xRgC2 = Application.InputBox("Select the column for input:", "Kutools for Excel", , , , , , 8)
If xRgC2 Is Nothing Then Exit Sub
If xRgC2.Columns.Count 1 Then
MsgBox "Please select single column"
GoTo SsRg
End If
SssRg:
Set xRgC3 = Application.InputBox("Select the column for output:", "Kutools for Excel", , , , , , 8)
If xRgC3 Is Nothing Then Exit Sub
If xRgC3.Columns.Count 1 Then
MsgBox "Please select single column"
GoTo SssRg
End If
Set xWs = xRg.Worksheet
For Each xRgF1 In xRgC1
For Each xRgF2 In xRgC2
If xRgF1.Value = xRgF2.Value Then xRgF3 = "einblenden"
Next xRgF2
Next xRgF1
For Each xRgF1 In xRgC1
For Each xRgF2 In xRgC2
If xRgF1.Value = xRgF2.Value Then
xRgF2.Interior.ColorIndex = 4
End If
Next
Next
End Sub