Hallo Till,
zunächst einmal vielen Dank für deine Mühe ;)...
Wie gesagt, bei Ausführung wird nur die letzte Bedingung beachtet (Also FREMD und L9.5 oder L9.6). Hier mal mein gesamter Code:
Option Explicit
Private Sub CommandButton1_Click()
Dim intRow As Integer, intLastRow As Integer
Dim ASH As Worksheet, gesamt As Worksheet, unbetrachtet As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim rngZelle As Range
Dim lngAnz As Long
Dim V1, V2, V3
Dim NWB As Workbook 'neues workbook
'Zuweisung der Tabellen zu den Variablen
With ThisWorkbook
Set ASH = .ActiveSheet
Set gesamt = .Worksheets("Gesamtauszug")
End With
'Formeln werden entfernt
For Each rngZelle In ThisWorkbook.ActiveSheet.UsedRange
'prüfen ob Zelle eine Formel enthält
If rngZelle.HasFormula = True Then
rngZelle.Rows.Delete
lngAnz = lngAnz + 1
End If
Next rngZelle
'hier wird die länge der Quelltabelle ermittelt und in die Zieltabelle eingef?gt
lngZeilen = gesamt.Cells(gesamt.Rows.Count, 2).End(xlUp).Row
x = 1
'*********************
'*Workbook hinzufügen*
'*********************
Set NWB = Workbooks.Add
With NWB
Set unbetrachtet = .Sheets(1)
.Sheets(1).Name = "nicht_betrachtete Datensätze"
Application.DisplayAlerts = False
.Sheets(2).Delete
.Sheets(2).Delete
Application.DisplayAlerts = True
End With
'Schleife die die Quelltabelle durchsucht und bei bestimmter Bedingung wird die Aktion copy-paste gestartet
For y = 3 To lngZeilen
'Bedingungen
With gesamt
V1 = .Cells(y, 11).Value
V2 = .Cells(y, 4).Value
V3 = .Cells(y, 3).Value
End With
If Not V1 Like "W*" _
And V1 <> "" Then
If V2 Like "ROTES*" _
Or V2 Like "TANKK*" _
Or V2 Like "FREMD*" And V3 Like "L9.5" _
Or V3 Like "L9.6" Then
' Or V2 Like "EZW*"
gesamt.Rows(y).Copy unbetrachtet.Rows(x)
x = x + 1
End If
End If
Next y
'************************************
'*neues Workbook speichern/schließen*
'************************************
With NWB
.SaveAs Environ("UserProfile") & "\Desktop\Nicht betrachtete Datensätze.xls"
'.Close (False)
End With
'hier werden die leeren Zeilen entfernt
With ASH
intLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(.Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
For intRow = intLastRow To 1 Step -1
If IsEmpty(.Cells(intRow, 11)) Then
ASH.Rows(intRow).Delete
End If
Next intRow
End With
End Sub
Ich habe natürlich mehr Spalten (40) und mehr DS (ca. 25000)...aber die zu betrachtenden Spalten wären nur die 3.
Quelltabelle:
Leasingart VC.Mode FahrzeugID
L9.1 970120_x DATENLEICHE
L9.2 940120_x W12345
ROTES KENNZEICHEN
L9.0 EZW_DUMMY LÖSCHEN
L9.0 EZW_DUMMY DOPPELT
L9.0 EZW_DUMMY W43210
L9.5 FREMD W00000
L9.5 FREMD DOPPELT
L9.3 FREMD DOPPELT
L9.3 FREMD W98765
Anforderungsbeschreibung: ausschneiden/kopieren....
1.) Wenn in Spalte FahrzeugID Werte enthalten sind die nicht mit W* anfangen und nicht Leer sind.
2.) Wenn in Spalte VCMode Werte enthalten sind mit ROTES*, TANK* und FREMD
3) Datensätze mir FREMD sollen allerdings nur ausgeschnitten/kopiert werden, wenn die Leasingart gleich L9.5 oder L9.6 enthalten. Allerdings auch die L9.3 mit FREMD, die in FahrzeugID kein W* besitzen (z. B. DOPPELT).
Gruß Sino
|