Tabelle vergleichen

Private Sub CommandButton1_Click() Dim wks As Worksheet Dim rngA As Range, rngB As Range Dim iRow As Integer, iCounter As Integer, iCol As Integer Application.ScreenUpdating = False Set rngA = Worksheets("Tabelle1").Range("A1").CurrentRegion Set rngB = Worksheets("Tabelle2").Range("A1").CurrentRegion Set wks = Worksheets("Tabelle3") iCol = rngA.Columns.Count If rngB.Columns.Count > iCol Then iCol = rngB.Columns.Count End If For iCounter = 1 To iCol wks.Cells(1, iCounter) = "Spalte" & iCounter Next iCounter wks.Rows(1).Font.Bold = True rngA.Range("A1").CurrentRegion.Copy wks.Range("A2") iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1 rngB.Range("A1").CurrentRegion.Copy wks.Cells(iRow, 1) wks.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=wks.Cells(1, wks.UsedRange.Columns.Count + 1), _ Unique:=True wks.Range(wks.Cells(1, 1), wks.Cells(1, iCol)). _ EntireColumn.Delete wks.Columns.AutoFit End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub nur_doppelte() i = 2 While Cells(i, 1) <> "" If Cells(i, 1) <> Cells(i + 1, 1) Then Rows(i).Delete ElseIf Cells(i, 2) <> Cells(i + 1, 2) Then Rows(i).Delete Else 'i = i + 1 While Cells(i, 1) = Cells(i + 1, 1) And Cells(i, 2) = Cells(i + 1, 2) Rows(i + 1).Delete Wend i = i + 1 End If Wend End Sub

Danke, Volkert. Dein Programm funktioniert, sobald sortiert wurde. Ich bin jetzt allerdings schon eine Stunde am rumbasteln, warum das Sortieren nicht funktioniert.
Natürlich übersehe ich eine Kleinigkeit... learning-by-probiering... Ohne die wksA-SET-Variable kommt keine Fehlermeldung, dann allerdings sortiert er mir Tabelle1, mit der wksA-SET-Variablen bringt er einen Laufzeitfehler.


Private Sub CommandButton1_Click()
Dim Target As Range
Dim wks As Worksheet
Dim rngA As Range, rngB As Range
Dim iRow As Integer, iCounter As Integer, iCol As Integer
Application.ScreenUpdating = False
Set rngA = Worksheets("Tabelle1").Range("A1").CurrentRegion
Set rngB = Worksheets("Tabelle2").Range("A1").CurrentRegion
Set wks = Worksheets("Tabelle3")
Set wksA = Worksheets("Tabelle3").Range("A1").CurrentRegion
'SpalteA,B von Tabelle1 und Tabelle2 werden nach Tabelle3 kopiert
iCol = rngA.Columns.Count
If rngB.Columns.Count > iCol Then
iCol = rngB.Columns.Count
End If
For iCounter = 1 To iCol
wks.Cells(1, iCounter) = "Spalte" & iCounter
Next iCounter
wks.Rows(1).Font.Bold = True
rngA.Range("A1").CurrentRegion.Copy wks.Range("A2")
iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
rngB.Range("A1").CurrentRegion.Copy wks.Cells(iRow, 1)
'Sprung auf Überschrift von Tabelle3
Application.Goto Reference:="Extract"
'Sortieren von Tabelle 3
wksA.Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Datensatzduplikate herausfiltern (by Volkert)
i = 2
While Cells(i, 1) <> ""
If Cells(i, 1) <> Cells(i + 1, 1) Then
Rows(i).Delete
ElseIf Cells(i, 2) <> Cells(i + 1, 2) Then
Rows(i).Delete
Else
While Cells(i, 1) = Cells(i + 1, 1) And Cells(i, 2) = Cells(i + 1, 2)
Rows(i + 1).Delete
Wend
i = i + 1
End If
Wend
wks.Columns.AutoFit
End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabelle vergleichen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread