Hi!
Ich habe ein MAkro geschriben, das genau das macht was ich NICHT will- s. unten.
Was ich will: Vergleiche Spalte B in Tabelle 1 mit Spalte B in TAbelle 2.Wenn identisch vergleiche Spalte D in TAb. 1 mit Spalte D in Tab. 2. Wenn diese Werte ungleich sind, kopiere die Zeile in Tabelle3.
Was das Makro macht ist die Zeilen mit gleichen Werten in Spalte D zu kopieren.
Makro: Sub Spaltenvergleich()
Dim LoI As Long ’ 1. Schleifenvariable
Dim LoJ As Long ’ 2. Schleifenvariable
Dim LoLetzte1 As Long ’ Variable letzte Zeile in Tabelle1
Dim LoLetzte2 As Long ’ Variable letzte Zeile in Tabelle2
Dim Loletzte3 As Long ’ Variable letzte Zeile in Tabelle3
Application.ScreenUpdating = False ’ Bildschirmaktualisierung aus
With Worksheets(„Tabelle1“) ’ letzte Zeile in Spalte B Tabelle1
LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, .Rows.Count)
End With
With Worksheets(„Tabelle2“) ’ letzte Zeile in Spalte B Tabelle2
LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, .Rows.Count)
End With
With Worksheets(„Tabelle1“) ’ letzte Zeile in Spalte B Tabelle1
LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 4)), .Cells(Rows.Count, 4).End(xlUp).Row, .Rows.Count)
End With
With Worksheets(„Tabelle2“) ’ letzte Zeile in Spalte B Tabelle2
LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 4)), .Cells(Rows.Count, 4).End(xlUp).Row, .Rows.Count)
End With
For LoI = 1 To LoLetzte1 ’ 1. Schleife alle Werte Spalte B
For LoJ = 1 To LoLetzte2 ’ 2. Schleife alle Werte Spalte B
If Worksheets(„Tabelle1“).Cells(LoI, 2) „“ Then ’ Leerzellen nicht kennzeichnen
If Worksheets(„Tabelle1“).Cells(LoI, 2) = Worksheets(„Tabelle2“).Cells(LoJ, 2) Then
If Worksheets(„Tabelle1“).Cells(LoI, 4) Worksheets(„Tabelle2“).Cells(LoJ, 4) Then
End If
Worksheets(„Tabelle1“).Rows(LoI).Copy ’ Zellen sind gleich, Zeile Kopieren
With Worksheets(„Tabelle3“)
’ letzte belegte Zeile in Tabelle3 ermitteln
Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
If Loletzte3 > Rows.Count Then ’ ermittelte Zeilennummer mit max. Anzahl vergleichen
MsgBox „In Tabelle3 ist keine Zeile mehr frei“
Application.CutCopyMode = False ’ Zwischenspeicher löschen
Exit Sub
End If
.Rows(Loletzte3).PasteSpecial Paste:=xlValues ’ Werte übertragen
.Rows(Loletzte3).PasteSpecial Paste:=xlFormats ’ Formate übertragen
End With
Exit For ’ innere Schleife verlassen da Datensatz gefunden
End If
End If
Next LoJ
Next LoI
Application.CutCopyMode = False ’ Zwischenspeicher löschen
Application.ScreenUpdating = True ’ Bildschirmaktualisierung ein
End Sub
Was muss ich daran ändern, damit es so läuft wie ich es haben möchte?
Wie ist der Ausdruck für „und wenn“ sowie für „ungleich“?
Vielen Dank.
Grüße
