Zelleninhalt vergleichen

Hallo,
ich benötige Hilfe und hoffe Sie hier zu finden.
Ich schildere erstmal mein Problem.
Ich habe eine Arbeitsmappe, in der in Spalte E verschiedene Bezeichnungen sind.
Des weiteren habe ich eine andere Arbeitsmappe, in der in Spalte A auch Bezeichnungen sind, die aber nicht immer zu 100% mit denen der anderen Arbeitsmappe übereinstimmen.
Nun möchte ich, dass jede belegte Zelle in der Spalte E mit jeder Zelle aus dem Bereich A in der anderen Arbeitsmappe verglichen wird. Wenn eine Teilüberseinstimmung vorhanden ist (z.b. 6 identische aufeinanderfolgende Zeichen), dann soll ein anderer zu der Beschreibung gehörender Bereich in die Arbeitsmappe kopiert werden.
Ich denke, dass ich die Schleifen und das Kopieren mit meinen einfachen VBA-Kenntnissen hinbekomme, was aber momentan mein größtes Problem ist, ist der Vergleich der Zelleninhalte über die Arbeitsmappen hinweg.
Gibt es jemanden der mir da einen Tipp geben kann, wie ich das Problem angehen kann

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Datenabgleichen() Dim wb1 As Workbook, wb2 As Workbook Dim wks1 As Worksheet, wks2 As Worksheet Dim Zeile1 As Long, Zeile2 As Long Dim bIdentisch As Boolean, sWert_E As String Set wb1 = Workbooks("datei1.xls") Set wks1 = wb1.Worksheets("Tabelle1") Set wb2 = Workbooks("Datei2.xls") Set wks2 = wb2.Worksheets("Tabelle1") With wks1 For Zeile1 = 1 To .Cells(.Rows.Count, 5).End(xlUp).Row sWert_E = LCase(wks1.Cells(Zeile1, 5).Value) With wks2 For Zeile2 = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row bIdentisch = False If LCase(.Cells(Zeile2, 1).Value) = sWert_E Then bIdentisch = True ElseIf LCase(Left(.Cells(Zeile2, 1).Value, 6)) = Left(sWert_E, 6) Then bIdentisch = True End If If bIdentisch = True Then 'Werte as Tabelle in Datei 1 nacj Tabele in Datei 2 übernehmen .Cells(Zeile2, 7).Value = wks1.Cells(Zeile1, 10) End If Next End With Next End With End Sub

Danke dafür,
ich konnte doch noch dafür sorgen, das der Inhalt immer identisch ist.
Allerdings soll bei Übereinstimmung immer ein Bereich kopiert und eingefügt werden.
Ich habe versucht den Code etwas umzuschreiben, allerdings will das mit dem kopieren nicht klappen.
Ich wäre für weitere Infos dankbar.

Sub Datenabgleichen()
Dim wb1 As Workbook, wb2 As Workbook
Dim wks1 As Worksheet, wks2 As Worksheet
Dim Zeile1 As Long, Zeile2 As Long
Dim bIdentisch As Boolean, sWert_E As String
Set wb1 = Workbooks("Mappe1.xls")
Set wks1 = wb1.Worksheets("Tabelle1")
Set wb2 = Workbooks("Mappe2.xls")
Set wks2 = wb2.Worksheets("Tabelle1")
With wks1
For Zeile1 = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
sWert_E = .Cells(Zeile1, 5).Value
With wks2
For Zeile2 = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
bIdentisch = False
If .Cells(Zeile2, 1).Value = sWert_E Then
bIdentisch = True
'          ElseIf LCase(Left(.Cells(Zeile2, 1).Value, 6)) = Left(sWert_E, 6) Then
'            bIdentisch = True
End If
If bIdentisch = True Then
'Werte as Tabelle in Datei 1 nacj Tabele in Datei 2 übernehmen
'.Range(Cells(Zeile2, 4), Cells(Zeile2, 16)) = wks1.Range(Cells(Zeile1, 14), Cells( _
Zeile1, 26))
Workbooks("Mappe1.xls").Worksheets("Tabelle1").Range(Cells(Zeile1, 14), Cells( _
Zeile1, 25)).Copy _
Destination:=Workbooks("Mappe2.xls").Worksheets("Tabelle1").Cells(Zeile2, 3)
'Value = .Range(.Cells(Zeile2, 3), .Cells(Zeile2, 15)).Value
End If
Next
End With
Next
End With
End Sub

If bIdentisch = True Then 'Werte aus Tabelle in Datei 1 nach Tabele in Datei 2 übernehmen 'Variante 1 - nur Werte ' .Range(.Cells(Zeile2, 4), .Cells(Zeile2, 16)).Value _ = wks1.Range(wks1.Cells(Zeile1, 14), wks1.Cells(Zeile1, 26)).Value 'Variante 2 - Zellen kopieren (Formeln, Werte, Formate) With wks1 ' .Range(.Cells(Zeile1, 14), .Cells(Zeile1, 25)).Copy _ Destination:=wks2.Cells(Zeile2, 3) End With 'Variante 3 - kopieren nur Werte und Formate With wks1 .Range(.Cells(Zeile1, 14), .Cells(Zeile1, 25)).Copy End With .Cells(Zeile2, 3).PasteSpecial Paste:=xlPasteFormats .Cells(Zeile2, 3).PasteSpecial Paste:=xlPasteValues End If

Sub Datenabgleichen() Dim wb1 As Workbook, wb2 As Workbook Dim wks1 As Worksheet, wks2 As Worksheet Dim Zeile1 As Long, Zeile2 As Long Dim bIdentisch As Boolean, sWert_E As String Set wb1 = Workbooks("Mappe1.xls") Set wks1 = wb1.Worksheets("Tabelle1") Set wb2 = Workbooks("Mappe2.xls") Set wks2 = wb2.Worksheets("Tabelle1") With wks1 For Zeile1 = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row sWert_E = .Cells(Zeile1, 5).Value With wks2 For Zeile2 = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row bIdentisch = False If .Cells(Zeile2, 1).Value = sWert_E Then bIdentisch = True ' ElseIf LCase(Left(.Cells(Zeile2, 1).Value, 6)) = Left(sWert_E, 6) Then ' bIdentisch = True End If If bIdentisch = True Then 'Werte as Tabelle in Datei 1 nacj Tabele in Datei 2 übernehmen '.Range(Cells(Zeile2, 4), Cells(Zeile2, 16)) = wks1.Range(Cells(Zeile1, 14), Cells( _ Zeile1, 26)) Workbooks("Mappe1.xls").Worksheets("Tabelle1").Range(Cells(Zeile1, 14), Cells( _ Zeile1, 25)).Copy _ Destination:=Workbooks("Mappe2.xls").Worksheets("Tabelle1").Cells(Zeile2, 3) 'Value = .Range(.Cells(Zeile2, 3), .Cells(Zeile2, 15)).Value End If Next End With Next End With End Sub

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelleninhalt vergleichen

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

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread