Microsoft Excel

Herbers Excel/VBA-Archiv

gleiche Zeilen löschen nach Bedingung | Herbers Excel-Forum


Betrifft: gleiche Zeilen löschen nach Bedingung von: sunni
Geschrieben am: 17.12.2009 13:38:06

Hallo alle zusammen,

ich habe in Tabelle 1 folgende Daten:
A B C
Name0 JA JA
Name1 NEIN JA
Name2 JA NEIN

Und in Tabelle 2:
Name0
Name0
Name0
Name1
Name2

Ich möchte nun gern, dass in Tabelle 2 ALLE gleichen Namen gelöscht werden (gesamte Zeile), wenn in Tabelle 1 in Spalte B und C jeweils ein JA steht. D.h. in diesem Beispiel: alle Zeilen mit "Name0" sind dann wech.

Ich bekomme die Codes einzeln hin, aber nicht alles zusammen (Vergleich und Löschen aller).

Vielen Dank im Voraus
sunni

  

Betrifft: AW: gleiche Zeilen löschen nach Bedingung von: Tino
Geschrieben am: 17.12.2009 13:56:39

Hallo,
kannst ja mal testen.
Ich gehe davon aus, dass in der Tabelle2 die Namen in Spalte A stehen.
Eventuell die Tabellen im Code noch anpassen.

Sub Loeschen_Mit_Formel()
Dim oSH As Worksheet, iCalc As Integer
Dim MatrixTab As String

'Tabelle anpassen wo die Zeilen gelöscht werden sollen 
Set oSH = Sheets("Tabelle2")
'Tabelle anpassen wo die Matrix mit ja und nein ist 
MatrixTab = "Tabelle1"


With Application
 iCalc = .Calculation
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 
     With oSH.UsedRange
        With .Columns(.Columns.Count).Offset(0, 1)
            
            .FormulaR1C1 = _
            "=IF(COUNTIF(" & MatrixTab & "!C1,RC1)>0,IF((VLOOKUP(RC1," & MatrixTab & "!C1:C2,2)=""JA"")*" & _
            "(VLOOKUP(RC1," & MatrixTab & "!C1:C3,3)=""JA""),TRUE,ROW()),ROW())" 'entsprechende Formel 
            
            oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
            
            On Error Resume Next
            .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
            On Error GoTo 0
            
            .EntireColumn.Delete
        End With
     End With
 
 .ScreenUpdating = True
 .Calculation = iCalc
End With


End Sub
Gruß Tino


  

Betrifft: AW: gleiche Zeilen löschen nach Bedingung von: sunni
Geschrieben am: 17.12.2009 15:04:44

Hey Tino,

danke erstmal für den Code. Ich hab nur Schwierigkeiten, ihn anzupassen mit den richtigen Zellen, da ich nicht genau weiss, wo.

Tabelle1: Der Name zum Abgleich steht in Spalte B(2), das erste JA in Spalte D(4), das zweite JA in Spalte E(5). Die Tabelle hat 600 gefüllte Zeilen (falls wichtig)
Tabelle2: Der Name steht hier in Spalte D(4). Die Tabelle hat 5000 gefüllte Zeilen (falls wichtig)

Könntest du mir den Code noch anpassen?


  

Betrifft: AW: gleiche Zeilen löschen nach Bedingung von: Tino
Geschrieben am: 17.12.2009 17:04:11

Hallo,
im ersten Beitrag hast Du was von Spalte A,B,C geschrieben, jetzt stehen die Daten ab Spalte B.

Ok. so müsste es nach Deinen angaben funktionieren.

Sub Loeschen_Mit_Formel()
Dim oSH As Worksheet, iCalc As Integer
Dim MatrixTab As String

'Tabelle anpassen wo die Zeilen gelöscht werden sollen 
Set oSH = Sheets("Tabelle2")
'Tabelle anpassen wo die Matrix mit ja und nein ist 
MatrixTab = "Tabelle1"


With Application
 iCalc = .Calculation
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 
     With oSH.UsedRange
        With .Columns(.Columns.Count).Offset(0, 1)
            
            .FormulaR1C1 = _
            "=IF(COUNTIF(" & MatrixTab & "!C2,RC4)>0,IF((VLOOKUP(RC4," & MatrixTab & "!C2:C5,3)=""JA"")*" & _
            "(VLOOKUP(RC4," & MatrixTab & "!C2:C5,4)=""JA""),TRUE,ROW()),ROW())" 'entsprechende Formel 
            
            oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
            
            On Error Resume Next
            .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
            On Error GoTo 0
            
            .EntireColumn.Delete
        End With
     End With
 
 .ScreenUpdating = True
 .Calculation = iCalc
End With


End Sub
Gruß Tino


Beiträge aus den Excel-Beispielen zum Thema "gleiche Zeilen löschen nach Bedingung"