Microsoft Excel

Herbers Excel/VBA-Archiv

Filterkriterium aus anderer Datei holen

Betrifft: Filterkriterium aus anderer Datei holen von: Tamás
Geschrieben am: 20.10.2020 09:59:38

ich hatte kürzlich um Hilfe bei einem Problem gebeten:
https://www.herber.de/forum/archiv/1784to1788/1786915_Range_anhand_Inhalt_in_Spalte_A_loeschen.html

Ich benutze die Lösung:

Sub TT()
    Dim LR As Long, i As Long, RNG As Range
    On Error GoTo Fehler
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
     
     Set RNG = Columns("A:H")
     
     LR = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
     
     
     For i = LR To 1 Step -1
         If Cells(i, 1) Like "XYZ_P1*" Then
             Intersect(Rows(i), RNG).Delete xlUp
         
         End If
     Next
     
Fehler:
    '*** Rücksetzen
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
     
 End Sub
Nun möchte ich aber das Kriterium "XYZ_P1" variabel aus Zelle B2 in einer anderen Datei im csv Format beziehen:

For i = LR To 1 Step -1
If Cells(i, 1) Like "=C:\Users\" & Environ("Username") & "\Documents\TEST.csv!R2C2*" Then
Intersect(Rows(i), RNG).Delete xlUp

Das funktioniert so aber leider nicht. Wenn ich das Makro starte passiert einfach gar nichts. Es kommt auch keine Fehlermeldung.

Was mache ich falsch?

Gruß
Tamás

Betrifft: AW: Filterkriterium aus anderer Datei holen
von: Nepumuk
Geschrieben am: 20.10.2020 10:14:03

Hallo Tamás,

so kannst du nicht aus eine CSV lesen.

Teste mal:

Public Sub DeleteRows()
    Dim LR As Long, i As Long
    Dim strSEarch As String
    Dim RNG As Range
    Dim objWorkbook As Workbook
    
    On Error GoTo Fehler
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set objWorkbook = Workbooks.Open(Filename:="C:\Users\" & Environ$("Username") & "\Documents\TEST.csv", Local:=True)
    strSEarch = objWorkbook.Worksheets(1).Range("B2").Value & "*"
    Call objWorkbook.Close(SaveChanges:=False)
    
    Set RNG = Columns("A:H")
    
    LR = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
    
    For i = LR To 1 Step -1
        If Cells(i, 1) Like strSEarch Then
            Intersect(Rows(i), RNG).Delete xlUp
        End If
    Next
    
    Fehler:
    '*** Rücksetzen
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

Gruß
Nepumuk

Betrifft: AW: Filterkriterium aus anderer Datei holen
von: Tamás
Geschrieben am: 20.10.2020 11:48:23

Hallo Nepumuk,

das funktioniert leider auch nicht, in Zeile

Set objWorkbook = Workbooks.Open(Filename:="C:\Users\" & Environ$("Username") & "\Documents\TEST.csv", Local:=True)

kommt wohl ein Error und er springt zu
Fehler:
'*** Rücksetzen

Gruß
Tamás

Betrifft: AW: Filterkriterium aus anderer Datei holen
von: Nepumuk
Geschrieben am: 20.10.2020 12:07:00

Hallo Tamás,

funktioniert bei mir einwandfrei. Prüf nochmal den Dateispeicherort. Bei mir hat der Dokumentenordner den du Links im Explorer siehst folgenden Pfad: C:\Users\Gepard\OneDrive\Documents Gepard ist mein Anmeldename.

Gruß
Nepumuk

Betrifft: AW: Filterkriterium aus anderer Datei holen
von: Tamás
Geschrieben am: 20.10.2020 13:39:51

Hallo Nepumuk,

jetzt funktioniert es.
Da habe ich vorhin wohl irgendwo noch einen Fehler eingebaut.

Vielen lieben Dank

Gruß
Tamás

Betrifft: AW: Filterkriterium aus anderer Datei holen
von: Tamás
Geschrieben am: 20.10.2020 14:07:30

Eine Frage hätte ich noch: Was muss ich anpassen wenn ich statt Spalte A-H nun Spalte L-AP löschen möchte? Das Filterkriterium steht nun in Spalte H.

Gruß
Tamás

Betrifft: AW: Filterkriterium aus anderer Datei holen
von: Tamás
Geschrieben am: 20.10.2020 14:09:01

Sorry Tippfehler. Das Filterkriterium steht natürlich in Spate L.

Betrifft: AW: Filterkriterium aus anderer Datei holen
von: Nepumuk
Geschrieben am: 20.10.2020 14:14:26

Hallo Tamás,

so:

Option Explicit

Public Sub DeleteRows()
    Dim LR As Long, i As Long
    Dim strSEarch As String
    Dim RNG As Range
    Dim objWorkbook As Workbook
    
    On Error GoTo Fehler
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set objWorkbook = Workbooks.Open(Filename:="C:\Users\" & _
        Environ$("Username") & "\Documents\TEST.csv", Local:=True)
    strSEarch = objWorkbook.Worksheets(1).Range("B2").Value & "*"
    Call objWorkbook.Close(SaveChanges:=False)
    
    Set RNG = Columns("L:AP")
    
    LR = Cells(Rows.Count, 12).End(xlUp).Row 'letzte Zeile der Spalte
    
    For i = LR To 1 Step -1
        If Cells(i, 12) Like strSEarch Then
            Intersect(Rows(i), RNG).Delete xlShiftUp
        End If
    Next
    
    Fehler:
    '*** Rücksetzen
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

Gruß
Nepumuk

Betrifft: AW: Filterkriterium aus anderer Datei holen
von: Tamás
Geschrieben am: 21.10.2020 09:20:23

Sehr schön. Das klappt dann auch.
Nochmals vielen lieben Dank.

Gruß
Tamás

Beiträge aus dem Excel-Forum zum Thema "Filterkriterium aus anderer Datei holen"