Inhalt von Spalten vergleichen und verschieben

Hallo zusammen
Habe folgendes Problem:
In der Spalte A sind gewisse Werte erfasst und in Spalte B ebenfalls. Jeder Wert kommt pro Spalte höchstens einmals vor. Es kann aber sein dass eine Spalte Werte enthält, welche die Andere nicht hat.
Gibt es ein Makro, welches die gleichen Werte in dieselbe Zeile verschiebt?
Von Hand mache ich das so: Beide Spalten separat sortieren und danach von Hand Zellen einfügen wo eine Spalte einen Wert entählt, welche in der Anderen nicht vorhanden ist.
Bei einer grossen Liste ist das aber extrem aufwändig.
Ausgangslage:
A B
1 1
2 2
4 3
5 4
6 6
Resultat:
A B
1 1
2 2
_ 3
4 4
5 _
6 6
Scheint mir ein simples Problem zu sein, aber noch aufwändig zu programmieren. Hat das jemand schon mal gemacht?
Grüsse
Reto E.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Abgleich() Range(Cells(1, 1), Cells(Cells(1, 1).End(xlDown).Row, 1)).Sort _ key1:=Cells(1, 1), order1:=xlAscending, header:=xlNo Range(Cells(1, 2), Cells(Cells(1, 2).End(xlDown).Row, 2)).Sort _ key1:=Cells(1, 2), order1:=xlAscending, header:=xlNo Cells(1, 1).Select Do If Selection Selection.Offset(0, 1) Then Selection.Insert Shift:=xlDown End If Selection.Offset(1, 0).Select Loop Until Selection = "" Or Selection.Offset(0, 1) = "" End Sub

Hallo Reto,
versuch einmal das beigefügte Makro:

Option Explicit
Public Sub Verschieben()
Dim lZeile     As Long
Dim lLetzte_A  As Long
Dim lLetzte_B  As Long
   With Worksheets("Tabelle1") ' <== Tabellenblattnamen ggf. anpassen !!!
      lLetzte_A = .Cells(Rows.Count, 1).End(xlUp).Row
      lLetzte_B = .Cells(Rows.Count, 2).End(xlUp).Row
      lZeile = 2               ' Start in Zeile 2
      Do Until .Cells(lZeile, 1) = "" And .Cells(lZeile, 2) = ""
         If .Cells(lZeile, 1) > .Cells(lZeile, 2) Then
            .Range("A" & lZeile & ":A" & lLetzte_A).Copy _
               Destination:=.Range("A" & lZeile + 1)
            .Range("A" & lZeile) = .Range("B" & lZeile)
            lLetzte_A = lLetzte_A + 1
         ElseIf .Cells(lZeile, 2) > .Cells(lZeile, 1) Then
            .Range("B" & lZeile & ":B" & lLetzte_B).Copy _
               Destination:=.Range("B" & lZeile + 1)
            .Range("B" & lZeile) = .Range("A" & lZeile)
            lLetzte_B = lLetzte_B + 1
         End If
         lZeile = lZeile + 1
      Loop
   End With
End Sub

Gruß Peter

Beliebteste Forumthreads (12 Monate)

Inhalt von Spalten vergleichen und verschieben

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Inhalt von Spalten vergleichen und verschieben

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread