Code anpassen

Forumthread: Code anpassen

Code anpassen

15.12.2016 13:33:31

kurt

Hallo,
ich habe diesen Code von UweD:

Sub Loeschen()
Dim TB1, Pfad As String, Datei As String, Blatt As String
Dim LR As Long, EZ As Integer
'- Vorgaben Pfad
Set TB1 = ThisWorkbook.Sheets("Tabelle1")
Pfad = "C:\..."
Datei = "Mappe2.xlsx"
Blatt = "Tabelle1"
EZ = 2 '
'-Ende Vorgaben
Datei = "[" & Datei & "]"
With TB1
LR = .Cells(.Rows.Count, "A").End(xlUp).row       'letzte Zeile der Spalte
.Range(Cells(EZ, 4), Cells(LR, 4)).Formula = _
"=IFERROR(VLOOKUP(A2,'" & Pfad & Datei & Blatt & "'!$A:$E,5,0),"""")"
.Cells(1, 4) = "Tmp"                      'Eine vierte Spalte wird eingefügt
If .AutoFilterMode Then .AutoFilterMode = False   ' Autofilter ausschalten
.Columns(4).AutoFilter
.Columns(4).AutoFilter Field:=1, Criteria1:="nein"
.Rows(EZ & ":" & LR).Delete xlUp            'wenn "nein", dann Zeile löschen
.AutoFilterMode = False                     'Vierte Spalte löschen
.Columns(4).ClearContents
End Sub

Ich will diesen aber so anpassen: in der zweiten Tabelle stehen jetzt die Namen in der Reihe H und in Reihe I "ja" oder "nein". Des Weiteren soll der Code in der ersten Datei nicht die ganze Zeile löschen, sondern nur die Zellen G:H, in denen "ja" oder "nein" steht und der Name derselbe ist, wie in der 2. Tabelle. Die Spalte "Tmp" soll in der J Reihe erzeugt werden.
Hat jemand eine idee, wie ich das ändern kann? Ich habe es so versucht, es funktioniert aber leider nicht.
LR = .Cells(.Rows.count, "A").End(xlUp).row
.Range(Cells(EZ, 9), Cells(LR, 9)).Formula = _
"=IFERROR(VLOOKUP(A2,'" & Pfad & Datei & Blatt & "'!$A:$I,9,0),"""")"
.Cells(1, 7) = "Tmp"
' Autofilter ausschalten
If .AutoFilterMode Then .AutoFilterMode = False
.Columns(7).AutoFilter
.Columns(7).AutoFilter Field:=1, Criteria1:="nein"
.Range("G" & EZ & ":" & "H" & LR).Delete xlUp
.AutoFilterMode = False
.Columns(6).ClearContents
Danke!

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Code anpassen

15.12.2016 14:03:14

UweD
AW: Code anpassen

15.12.2016 15:02:55

kurt
AW: Code anpassen

15.12.2016 15:42:17

UweD
AW: Code anpassen

15.12.2016 16:10:56

kurt
AW: Code anpassen

15.12.2016 16:34:37

kurt

AW: Code anpassen

15.12.2016 14:03:14

UweD

Hello again
so?


Sub Loeschen()

    Dim TB1, Pfad As String, Datei As String, Blatt As String
    Dim LR As Long, EZ As Integer, SP As Integer
  
    '- Vorgaben Pfad 
    Set TB1 = ThisWorkbook.Sheets("Tabelle1")
    Pfad = "C:\temp\"
    Datei = "Mappe2.xlsx"
    Blatt = "Tabelle1"
    EZ = 2 ' 
    SP = 10 'Spalte J 
    '-Ende Vorgaben 
      
    Datei = "[" & Datei & "]"
    With TB1
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row       'letzte Zeile der Spalte 
        .Range(Cells(EZ, SP), Cells(LR, SP)).Formula = _
            "=IFERROR(VLOOKUP(A2,'" & Pfad & Datei & Blatt & "'!$H:$I,2,0),"""")"
        .Cells(1, SP) = "Tmp"                      'Eine Temporäre Spalte wird beschriftet 
        If .AutoFilterMode Then .AutoFilterMode = False   ' Autofilter ausschalten 
        .Columns(SP).AutoFilter
        .Columns(SP).AutoFilter Field:=1, Criteria1:="=ja", Operator:=xlOr, Criteria2:="=nein"
        .Range(Cells(EZ, 7), Cells(LR, 8)).ClearContents
        .AutoFilterMode = False                     'TMP Spalte löschen 
        .Columns(SP).ClearContents
    End With
    
End Sub

LG UweD

AW: Code anpassen

15.12.2016 15:02:55

kurt

Danke, es funktioniert! Die Zellen die gelöscht werden bleiben aber trotzdem leer stehen. Geht es irgendwie, dass die nach oben verschoben werden?

AW: Code anpassen

15.12.2016 15:42:17

UweD

Hallo
.Range(Cells(EZ, 7), Cells(LR, 8)).Delete xlUp
LG UweD

AW: Code anpassen

15.12.2016 16:10:56

kurt

Danke, das geht. das Problem ist, dass nicht nur die Zellen von G und H gelöscht werden, sondern die ganze Zeile von A bis zum Ende.
Was mir alternativ helfen könnte, ist wenn ein Filter "von A bis Z" in den Spalten G und H eingebaut wird und G sortiert. Dieser soll aber dann ausgeschaltet werden, sodass man nicht sieht, dass ein Filter gesetzt war.

AW: Code anpassen

15.12.2016 16:34:37

kurt

ich habe es so geschafft, geht es irgendwie schöner?


.Columns("G:I").Select
Selection.AutoFilter
TB1.AutoFilter.Sort.SortFields.Clear
TB1.AutoFilter.Sort.SortFields.Add Key:= _
Range("G1:G44798"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With TB1.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Beliebteste Forumthreads (12 Monate)

Forumthread: Code anpassen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread