Suche ungleicher Daten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub sortieren() Dim i As Integer For i = 1 To 20 If Sheets("Tabelle2").Cells(i, 1) "" And _ Sheets("Tabelle2").Cells(i, 1) & _ Sheets("Tabelle2").Cells(i, 2) _ Sheets("Tabelle1").Cells(i, 1) & _ Sheets("Tabelle1").Cells(i, 2) Then Sheets("Tabelle3").Cells(i, 1) = Sheets("Tabelle2").Cells(i, 1) Sheets("Tabelle3").Cells(i, 2) = Sheets("Tabelle2").Cells(i, 2) End If Next End Sub

Sub test3() Dim varA2 As Variant, varB2 As Variant, varTab2() As String Dim varA1 As Variant, varB1 As Variant, varTab1() As String Dim varTab3() As String, z As String, i As Long, x As Long, y As Long With Worksheets("Tabelle2") varA2 = .Range("A2:" & Range("A2").End(xlDown).Address) varB2 = .Range("B2:B" & Range("A2").End(xlDown).Row) End With ReDim varTab2(1 To UBound(varA2)) For i = LBound(varA2) To UBound(varA2) varTab2(i) = CStr(varA2(i, 1) & " " & varB2(i, 1)) Next With Worksheets("Tabelle1") varA1 = .Range("A2:" & Range("A2").End(xlDown).Address) varB1 = .Range("B2:B" & Range("A2").End(xlDown).Row) End With ReDim varTab1(LBound(varA1) To UBound(varA1)) For i = LBound(varA1) To UBound(varA1) varTab1(i) = CStr(varA1(i, 1) & " " & varB1(i, 1)) Next ReDim varTab3(LBound(varA2) To UBound(varA2)) For i = LBound(varTab2) To UBound(varTab2) z = varTab2(i) On Error Resume Next y = WorksheetFunction.Match(z, varTab1, 0) If Err.Number 0 Then varTab3(x + 1) = varTab2(i) Err.Clear x = x + 1 End If Next ReDim Preserve varTab3(1 To x) With Worksheets("Tabelle3") For i = 1 To UBound(varTab3) .Range("A" & i + 1) = Split(varTab3(i), " ")(0) .Range("B" & i + 1) = Split(varTab3(i), " ")(1) Next End Sub

Hallo Zusammen
Thomas: Bei dir erhalte ich immer noch nur den Unterschied der Zeilen.
Gerd: Bei deinem Code wird mir einfach die ganze Tabelle2 in die Tabell3 kopiert
Leider ist mein Wissen zu gering um zu verstehen was dein Code genau macht
ich verstehe nur das alle Daten der Tabelle1 und der Tabelle2 in einen temporären Speicher geschrieben werden. Aber wo findet der Vergleich statt was nur in der Tabelle2 vorkommt?
Ich möchte nur die Werte, die nur in der Tabelle2 vorkommen in die Tabelle3 schreiben.
Wenn ich manuell vorgehe um das Problem zu lösen sieht das so aus:
Ich nehme einen Wert aus der Tabelle2 und suche in der Tabelle1 ob dieser dort auch vorkommt. Wenn ja ok, wenn nein schreibe ich den Wert aus der Tabelle2 in die Tabelle3 usw bis alle Werte der Tabelle2 mit der Tabelle1 verglichen wurden und gegebenfalls in die Tabelle3 geschrieben wurden.
Vielleicht habt ihr noch eine Lösung.
Auf alle fälle Besten Dank für Eure Bemühungen.
Gruss Hugo

Sub test4() Dim varA2 As Variant, varB2 As Variant, varTab2() As String Dim varA1 As Variant, varB1 As Variant, varTab1() As String Dim varTab3() As String, z As String, i As Long, x As Long, y As Long With Worksheets("Tabelle2") varA2 = .Range("A2:" & Range("A2").End(xlDown).Address) varB2 = .Range("B2:B" & Range("A2").End(xlDown).Row) End With ReDim varTab2(1 To UBound(varA2)) For i = LBound(varA2) To UBound(varA2) varTab2(i) = CStr(varA2(i, 1) & " " & varB2(i, 1)) Next With Worksheets("Tabelle1") varA1 = .Range("A2:" & Range("A2").End(xlDown).Address) varB1 = .Range("B2:B" & Range("A2").End(xlDown).Row) End With ReDim varTab1(LBound(varA1) To UBound(varA1)) For i = LBound(varA1) To UBound(varA1) varTab1(i) = CStr(varA1(i, 1) & " " & varB1(i, 1)) Next ReDim varTab3(LBound(varA2) To UBound(varA2)) For i = LBound(varTab2) To UBound(varTab2) z = varTab2(i) On Error Resume Next y = WorksheetFunction.Match(z, varTab1, 0) If Err.Number 0 Then varTab3(x + 1) = varTab2(i) Err.Clear x = x + 1 End If On Error GoTo 0 Next ReDim Preserve varTab3(1 To x) With Worksheets("Tabelle3") For i = 1 To UBound(varTab3) .Range("A" & i + 1) = Split(varTab3(i), " ")(0) .Range("B" & i + 1) = Split(varTab3(i), " ")(1) Next End With End Sub

Hallo Hugo,
kleine Ursache, große Wirkung. Da habe ich doch tatsächlich mal wieder meinen Lieblingsfehler
eingbaut u. innerhalb der With - End With - Blöcke vergessen, vor "Range.." die Pünktchen zu
setzen. Dies fiel mir nicht auf, da ich nicht von der aktivierten Tabelle3 aus getestet habe u.
in meinen Testdaten die Bereichsgrößen in Tabelle1 u. Tabelle2 identisch waren.
Entschuldige bitte.
Eine kleine Einschränkung muss ich noch machen. Die Wörter in Spalten "B" sollten keine
Leerzeichen enthalten, sonst müsste man noch etwas ändern.
Den Code kannst Du von hier in ein Tabellenblatt kopieren u. von dort in ein Modul,
musst also nicht abtippen. Eine Rückmeldung, ob' s jetzt läuft ware nett.
Gruß Gerd


Sub test5()
Dim varA2 As Variant, varB2 As Variant, varTab2() As String
Dim varA1 As Variant, varB1 As Variant, varTab1() As String
Dim varTab3() As String, z As String, i As Long, x As Long, y As Long
With Worksheets("Tabelle2")
varA2 = .Range("A2:" & .Range("A2").End(xlDown).Address)
varB2 = .Range("B2:B" & .Range("A2").End(xlDown).Row)
End With
ReDim varTab2(1 To UBound(varA2))
For i = LBound(varA2) To UBound(varA2)
varTab2(i) = CStr(varA2(i, 1) & " " & varB2(i, 1))
Next
With Worksheets("Tabelle1")
varA1 = .Range("A2:" & .Range("A2").End(xlDown).Address)
varB1 = .Range("B2:B" & .Range("A2").End(xlDown).Row)
End With
ReDim varTab1(LBound(varA1) To UBound(varA1))
For i = LBound(varA1) To UBound(varA1)
varTab1(i) = CStr(varA1(i, 1) & " " & varB1(i, 1))
Next
ReDim varTab3(LBound(varA2) To UBound(varA2))
For i = LBound(varTab2) To UBound(varTab2)
z = varTab2(i)
On Error Resume Next
y = WorksheetFunction.Match(z, varTab1, 0)
If Err.Number  0 Then
varTab3(x + 1) = varTab2(i)
Err.Clear
x = x + 1
End If
On Error GoTo 0
Next
ReDim Preserve varTab3(1 To x)
With Worksheets("Tabelle3")
For i = 1 To UBound(varTab3)
.Range("A" & i + 1) = Split(varTab3(i), " ")(0)
.Range("B" & i + 1) = Split(varTab3(i), " ")(1)
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

	A	B
1	03	Gurken
2	02	Salat
3	04	Trauben

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread