AW: Gleiches zusammenfassen und schreiben
17.03.2005 16:28:43
ah
Habe jetzt folgenden Code gefunden,
wie kann ich nun anstatt mit einer Tabelle in der selben Arbeitsmappe mit einer Tabelle in der anderen Arbeitsmappe vergleichen?
MFG
Artur
Sub Tabellen_Vergleichen4()
'* H. Ziplies *
'* 16.06.04; 03.03.05 *
'* erstellt von Hajo.Ziplies@web.de *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
' 2 Tabellen vergleichen Tabelle1 Spalte A mit Tabelle2 Spalte B
' und und gleiche in Tabelle 3 kopieren aus Tabelle 1
' Tabelle1 Original Spalte A, Tabelle 2 Kopie Spalte B
Dim LoI As Long
Dim LoJ As Long
Dim LoLetzte1 As Long
Dim LoLetzte2 As Long
Dim Loletzte3 As Long
With Worksheets("Tabelle1")
LoLetzte1 = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row, 65536)
End With
With Worksheets("Tabelle2") --> hier müsste ich die andere Arbeitsmappe einfügen,die heisst Januar und hat die Tabelle Sheet1
LoLetzte2 = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
End With
For LoI = 1 To LoLetzte1
For LoJ = 1 To LoLetzte2
' Leerzellen nicht kennzeichnen
If Worksheets("Tabelle1").Cells(LoI, 1) <> "" Then
If Worksheets("Tabelle1").Cells(LoI, 1) = Worksheets("Tabelle2").Cells(LoJ, 2) Then
Worksheets("Tabelle1").Rows(LoI).Copy
With Worksheets("Tabelle3")
Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
If Loletzte3 > 65536 Then
MsgBox "In Tabelle3 ist keine Zeile mehr frei"
Application.CutCopyMode = False
Exit Sub
End If
.Rows(Loletzte3).PasteSpecial Paste:=xlValues ' Werte
.Rows(Loletzte3).PasteSpecial Paste:=xlFormats ' Formate
End With
Exit For ' innere Schleife verlassen da Datensatz gefunden
End If
End If
Next LoJ
Next LoI
Application.CutCopyMode = False
End Sub