Anzeige
Archiv - Navigation
1368to1372
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spaltenvergleich mit Bedingung

Spaltenvergleich mit Bedingung
08.07.2014 11:08:00
Henry

Guten Morgen Zusammen,
hoffen wir auf heute Abend ! :)
Ich habe leider ein kleines Excel Pro blem und hoffe mir kann geholfen werden.
In meiner Arbeitsmappe habe ich 3 Tabellenblätter.
TB1
Spalte C = Rechnungsnummern
Spalte L = YES / NO Prüfung
TB2
Spalte C = Rechnungsnummern
Ich würde gern per VBA prüfen ..
1) Wenn in TB1 Spalte L ein Yes steht dann prüfen ob die Rg-No. aus Spalte C (TB1)
in Spalte C(Tabellenblatt2) vorkommt.
Wenn ja, dann kopiere die komplette Zeile aus TB2 in TB3
Diese Prüfung soll solange geamcht werden bis keine treffer in TB1 mehr gefunden
werden.
2) Nach dem kopieren soll die komplette Zeile in TB2 gelöscht werden.
Anbei eine Beispieldatei.
https://www.herber.de/bbs/user/91410.xls

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spaltenvergleich mit Bedingung
08.07.2014 12:15:47
Henry
Habe hier einen Code von Hajo ein bisschen angepasst und habe den ersten Teil damit abdecken können.
Er kopiert mir die gewünschten Zeilen in TB3
Mir fehlt jedoch noch das die kopierten Zeilen aus TB2 gelöscht werden .
HAbe versucht statt .copy dann rows.delete einzutragen hat aber leider nicht funktioniert.
Sub Tabellen_Vergleichtest()
'***********************************************
'* H. Ziplies *
'* 02.06.07 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/ *
'***********************************************
Dim LoI As Long ' 1. Schleifenvariable
Dim LoJ As Long ' 2. Schleifenvariable
Dim LoLetzte1 As Long ' Variable letzte Zeile in Spalte A
Dim LoLetzte2 As Long ' Variable letzte Zeile in Spalte B
Dim Loletzte3 As Long ' Variable letzte Zeile in Tabelle3
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
With Worksheets("Tabelle1") ' letzte Zeile in Spalte A Tabelle1
LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 3)), _
.Cells(Rows.Count, 3).End(xlUp).Row, .Rows.Count)
End With
With Worksheets("Tabelle2") ' letzte Zeile in Spalte B Tabelle2
LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 3)), _
.Cells(Rows.Count, 3).End(xlUp).Row, .Rows.Count)
End With
For LoI = 1 To LoLetzte1 ' 1. Schleife alle Werte Spalte A
For LoJ = 1 To LoLetzte2 ' 2. Schleife alle Werte Spalte B
' Leerzellen nicht kennzeichnen
If Worksheets("Tabelle1").Cells(LoI, 3) <> "" Then
If Worksheets("Tabelle1").Cells(LoI, 3) = _
Worksheets("Tabelle2").Cells(LoJ, 3) And Worksheets("Tabelle1").Cells(LoI, 12) = "YES" Then
' Zellen sind gleich, Zeile Kopieren
Worksheets("Tabelle2").Rows(LoJ).Copy
With Worksheets("Tabelle3")
' letzte belegte Zeile in Tabelle3 ermitteln
Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
' ermittelte Zeilennummer mit max. Anzahl vergleichen
If Loletzte3 > Rows.Count Then
MsgBox "In Tabelle3 ist keine Zeile mehr frei"
' Zwischenspeicher löschen
Application.CutCopyMode = False
Exit Sub
End If
' Werte übertragen
.Rows(Loletzte3).PasteSpecial Paste:=xlValues
' Formate übertragen
.Rows(Loletzte3).PasteSpecial Paste:=xlFormats
End With
' innere Schleife verlassen da Datensatz gefunden
Exit For
End If
End If
Next LoJ
Next LoI
Application.CutCopyMode = False ' Zwischenspeicher löschen
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein

Anzeige
AW: Spaltenvergleich mit Bedingung
08.07.2014 13:51:29
Hajo_Zi
sollte man nicht den gesamten Code kopieren, dann wird es vom Forum auch richtig eingerückt oder man benutzt den Schalter Code. Damit ist der Code übersichtlicher.
Ungetestet.

Option Explicit
Sub Tabellen_Vergleichtest()
'* H. Ziplies *
'* 08.07.14 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/
Dim LoI As Long ' 1. Schleifenvariable
Dim LoJ As Long ' 2. Schleifenvariable
Dim LoLetzte1 As Long ' Variable letzte Zeile in Spalte A
Dim LoLetzte2 As Long ' Variable letzte Zeile in Spalte B
Dim Loletzte3 As Long ' Variable letzte Zeile in Tabelle3
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
With Worksheets("Tabelle1") ' letzte Zeile in Spalte A Tabelle1
LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 3)), _
.Cells(Rows.Count, 3).End(xlUp).Row, .Rows.Count)
End With
With Worksheets("Tabelle2") ' letzte Zeile in Spalte B Tabelle2
LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 3)), _
.Cells(Rows.Count, 3).End(xlUp).Row, .Rows.Count)
End With
For LoI = 1 To LoLetzte1 ' 1. Schleife alle Werte Spalte A
For LoJ = 1 To LoLetzte2 ' 2. Schleife alle Werte Spalte B
' Leerzellen nicht kennzeichnen
If Worksheets("Tabelle1").Cells(LoI, 3) <> "" Then
If Worksheets("Tabelle1").Cells(LoI, 3) = _
Worksheets("Tabelle2").Cells(LoJ, 3) And Worksheets("Tabelle1").Cells(LoI,  _
12) = "YES" Then
' Zellen sind gleich, Zeile Kopieren
Worksheets("Tabelle2").Rows(LoJ).Copy
With Worksheets("Tabelle3")
' letzte belegte Zeile in Tabelle3 ermitteln
Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
' ermittelte Zeilennummer mit max. Anzahl vergleichen
If Loletzte3 > Rows.Count Then
MsgBox "In Tabelle3 ist keine Zeile mehr frei"
' Zwischenspeicher löschen
Application.CutCopyMode = False
Exit Sub
End If
' Werte übertragen
.Rows(Loletzte3).PasteSpecial Paste:=xlValues
' Formate übertragen
.Rows(Loletzte3).PasteSpecial Paste:=xlFormats
' Zellinhalt entfernen
Worksheets("Tabelle2").Rows(LoJ).ClearContents
' Zeile Löschen
'Worksheets("Tabelle2").Rows(LoJ).Delete
End With
' innere Schleife verlassen da Datensatz gefunden
Exit For
End If
End If
Next LoJ
Next LoI
Application.CutCopyMode = False ' Zwischenspeicher löschen
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein
End Sub

Anzeige
AW: Spaltenvergleich mit Bedingung
08.07.2014 14:05:59
Henry
Besten Dank, Hajo.
Funktioniert.
Worksheets("Tabelle2").Rows(LoJ).Delete 
Dann lag ich nicht ganz verkehrt denn das hatte ich auch probiert.
Nur leider an eine falsche Stelle gesetzt.
Naja bin ja noch am üben :)

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige