Makro anpassung

Bild

Betrifft: Makro anpassung
von: Thomas
Geschrieben am: 27.07.2015 09:09:50

Hallo excelfreunde,
ich lösche mit dem nachfolgenden Macro bestimmte leere Zeilen aus einer Tabelle.
Nun stehe ich vor dem Problem das sich die Spaltenanzahl in der Tabelle ständig verändert so das ich wie in diesem Beispiel die Spalte ( If Cells(LoI, 6) = "" Then) die 6 ständig das Macro anpassen muss. Kann jemand das Macro so anpassen das es den Wert welcher in Tabelle "Zellendefininion" B4 und B5 definiert ist in der Tabelle " Vorgang " sucht und diese Spalte dann als suchspalte für die leeren zellen nimmt und dann unterhalb der Fundstelle die leeren Zeilen löscht?
zur besseren Erläuterung habe ich es in der Beispiel Arbeitsmappe deutlich gemacht.
Ich habe schon sehr viel gesucht was dieses Thema Leerzeilen löschen angeht. Jedoch sind die meisten Vorschläge zu langsam oder ich schaffe es nicht an meinen Gegebenheiten anzupassen. Diese Version ist die schnellste aber auch dies kann ich nicht anpassen.
vielen dank für euer Interesse und vorab schon mal für die Hilfe.
Liebe grüsse thomas
https://www.herber.de/bbs/user/99081.xlsm

Sub leerzeilen_löschen()
    Dim LoLetzte As Long
    Dim LoI As Long
    Dim RaZeile As Range
    LoLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
    
    
    '  If LoLetzte < 8  keine Ahnung
    
    If LoLetzte < 8 Then Exit Sub
    
    
    ' = LoLetzte To 2  beginne Zeile 2
    For LoI = LoLetzte To 11 Step -1
    '########################################
    
    '<= 3 Then bedeutet kleiner als 3,
            If Cells(LoI, 6) = "" Then
            
        '  If Cells(LoI, 2 bedeutet in der 2. spalte
     '###############################################################
            
            If RaZeile Is Nothing Then
                Set RaZeile = Rows(LoI)
            Else
                Set RaZeile = Union(RaZeile, Rows(LoI))
            End If
        End If
       
    Next LoI
    If Not RaZeile Is Nothing Then RaZeile.Delete
    Set RaZeile = Nothing
End Sub

Bild

Betrifft: AW: Makro anpassung
von: Herbert Grom
Geschrieben am: 27.07.2015 11:10:59
Hallo Thomas,
probier's mal damit:
LoLetzte = IIf(IsEmpty(Range("F1048576")), Range("F1048576").End(xlUp).Row, 1048576)
Servus

Bild

Betrifft: AW: Makro anpassung
von: Thomas
Geschrieben am: 27.07.2015 11:47:26
Hallo,
besten Dank erst mal.
jedoch löst diese Veränderung leider nicht mein Problem. das die Spaltenangabe variabel wird.
liebe grüsse thomas

Bild

Betrifft: AW: Makro anpassung
von: Herbert Grom
Geschrieben am: 27.07.2015 12:40:13
Hallo Thomas,
da in Deiner Beispielmappe in Spalte 6 keinerlei Daten zu finden sind, kann ich auch nicht programmieren, woran ich die entsprechende Spalte identifizieren soll. Eine Überschrift der Spalte wäre hier z. B. sehr hilfreich.
Servus

Bild

Betrifft: AW: Makro anpassung
von: EtoPHG
Geschrieben am: 27.07.2015 14:11:29
Hallo Thomas,
simpel:

Sub leerzeilen_löschen()
    Dim lRow As Long, lCnt As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    lCnt = ws.UsedRange.Columns.Count
    For lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 11 Step -1
        If WorksheetFunction.CountA(ws.Rows(lRow)) < lCnt Then ws.Rows(lRow).Delete xlShiftUp
    Next lRow
End Sub
Gruess Hansueli

Bild

Betrifft: AW: Makro anpassung
von: Rudi Maintaire
Geschrieben am: 27.07.2015 14:11:59
Hallo,

Sub leerzeilen_löschen()
    Dim LoLetzte As Long
    Dim LoI As Long
    Dim RaZeile As Range
    Dim Spalte1 As Long, Spalte2 As Long
    LoLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
    
    Spalte1 = Application.Match(Sheets("zellendefininion").Range("B4"), Sheets("Vorgang").Rows( _
10), 0)
    Spalte2 = Application.Match(Sheets("zellendefininion").Range("B5"), Sheets("Vorgang").Rows( _
10), 0)
    
    '  If LoLetzte < 8  keine Ahnung
    
    If LoLetzte < 8 Then Exit Sub
    
    
    ' = LoLetzte To 2  beginne Zeile 2
    For LoI = LoLetzte To 11 Step -1
    '########################################
    
    '<= 3 Then bedeutet kleiner als 3,
            If Cells(LoI, Spalte1) = "" Or Cells(LoI, Spalte2) = "" Then
            
        '  If Cells(LoI, 2 bedeutet in der 2. spalte
     '###############################################################
            
            If RaZeile Is Nothing Then
                Set RaZeile = Rows(LoI)
            Else
                Set RaZeile = Union(RaZeile, Rows(LoI))
            End If
        End If
       
    Next LoI
    If Not RaZeile Is Nothing Then RaZeile.Delete
    Set RaZeile = Nothing
End Sub

Gruß
Rudi

Bild

Betrifft: Rudi es passt fast
von: Thomas
Geschrieben am: 27.07.2015 15:48:06
Hallo an allen Helfern,
Vielen Dank
Rudi deine Version passt fast. Kannst Du noch einbauen das B5 in Tabelle "Zellendefininion" auch leer sein darf? ( dann soll nur b4 als Prüfung dienen).
vielen dank für deine Mühe
liebe grüsse thomas

Bild

Betrifft: AW: Rudi es passt fast
von: Rudi Maintaire
Geschrieben am: 27.07.2015 17:06:04
Hallo,

Sub leerzeilen_loeschen()
  Dim LoLetzte As Long
  Dim LoI As Long
  Dim RaZeile As Range, rLeer As Range
  Dim Spalte1 As Long, Spalte2 As Long
  
  LoLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
  
  With Sheets("zellendefininion")
    Spalte1 = Application.Match(.Range("B4"), Rows(10), 0)
    If .Range("B5") <> "" Then
      Spalte2 = Application.Match(.Range("B5"), Rows(10), 0)
    End If
  End With
  
  If LoLetzte < 8 Then Exit Sub
  
  For LoI = LoLetzte To 11 Step -1
    Set rLeer = Nothing
    If Spalte2 > 0 Then
      If Cells(LoI, Spalte1) = "" Or Cells(LoI, Spalte2) = "" Then
        Set rLeer = Rows(LoI)
      End If
    Else
      If Cells(LoI, Spalte1) = "" Then
        Set rLeer = Rows(LoI)
      End If
    End If
    If Not rLeer Is Nothing Then
      If RaZeile Is Nothing Then
        Set RaZeile = rLeer
      Else
        Set RaZeile = Union(RaZeile, rLeer)
      End If
    End If
  Next LoI
  If Not RaZeile Is Nothing Then RaZeile.Delete
  Set RaZeile = Nothing
End Sub
Gruß
Rudi

Bild

Betrifft: besten Dank an Rudi Maintaire
von: Thomas
Geschrieben am: 27.07.2015 17:15:32
Hallo Rudi,
klasse super es passt wie "Po auf Eimer".
vielen dank für deine Hilfe und das heut schon bei zwei Problemen.
liebe grüsse thomas

Bild

Betrifft: AW: Rudi es passt fast
von: Herbert Grom
Geschrieben am: 27.07.2015 18:13:59
Hallo Rudi,
da habe ich vorher einfach nicht richtig hingeschaut! ;o(=(
Meine Frage: Damit (If Not RaZeile Is Nothing Then RaZeile.Delete) werde die gefundenen Zeilen gelöscht. Gibt es auch eine Möglichkeit, die gefundenen Zeilen damit nur auszublenden anstatt zu löschen?
Servus

Bild

Betrifft: AW: Rudi es passt fast
von: Michael
Geschrieben am: 27.07.2015 20:22:45
Hi Herbert,
zur Illustration:

Sub zeile_ausblenden()
Dim RaZeile As Range
Set RaZeile = Selection
If Not RaZeile Is Nothing Then RaZeile.Rows.Hidden = True
End Sub
Tut auch mit nicht zusammenhängenden Bereichen.
Schöne Grüße aus Nürnberg,
Michael

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makro anpassung"