Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1272to1276
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Veränderliche Spalten durchsuchen

Veränderliche Spalten durchsuchen
Peter
Hallo liebes Forum,
bevor ich zu meinem Problem komme, möchte ich mich erstmal bei allen bedanken, die hier zur Problemlösung beitragen. Ich habe hier schon einiges gefunden was mir weitergeholfen hat.
Das jetztige Problem hab ich noch nirgendwo gefunden.
Ich habe eine Tabelle mit jeder Menge Daten die ich durch VBA formatieren und nach bestimmten Kriterien durchsuchen lassen möchte. Das Problem dabei ist, dass sich die Tabelle jährlich um ein Jahr (also insgesamt vier Spalten) erweitert und sich damit auch der gewünschte Betrachtungszeitraum ändert. Ich habe einfach mal eine Beispieldatei hinzugefügt damit mein Problem besser verständlich ist. https://www.herber.de/bbs/user/81444.xlsx
Folgendes würde ich gerne machen:
1. Das Makro soll nach der Spalte "Gesamt Ist 2011 + Plan 2012 bis 2013" (Spalte AH) suchen und dann alle Zeilen löschen wo gleichzeitig für E, I, S eine Null steht löschen. Der Clou an der ganzen Sache ist der, dass sich Text in den entsprechenden Spalten jährlich ändert. Also im Jahr 2013 soll Spalte "Gesamt Ist 2012 + Plan 2013 bis 2014" (Spalte AH) gesucht werden und dann alle Zeilen gelöschen werden wo gleichzeitig für E, I, S eine Null drinne steht.
2. Zusätzlich kommt hinzu, dass unter jeder Zeile noch 4 Zeilen ausgeblendet sind. Wenn das Makro von Punkt 1 die Spalten E, I, S unter "Gesamt Ist 2011 + Plan 2012 bis 2013" (Spalte AH) durchsucht, sollen die ausgeblendeten Zeilen davon ausgenommen sein. Ich habe das ganze mal beispielhaft für die ersten zwei Zeilen gemacht. In der Realität ist unter jeder Zeile 4 Zeilen ausgeblendet.
Ich weiß nicht ob das ganze überhaupt zu realisieren ist?! Ich wäre euch aber für jede Anregung dankbar.
Vielen Dank vorab schonmal & einen schönen Abend!
LG Peter
AW: Veränderliche Spalten durchsuchen
15.08.2012 18:00:27
Josef

Hallo Peter,
in deinem Beispiel steht "... bis 2015"!
Teste mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub deleteEmptyRows()
  Dim rng As Range, rngRow As Range, rngDelete As Range
  Dim vntRet As Variant
  Dim strSearch As String
  Dim lngCalc As Long, lngLast As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  strSearch = "Gesamt*" & Year(Date) - 1 & "*" & Year(Date) & "*" & Year(Date) + 1
  
  With ActiveSheet
    vntRet = Application.Match(strSearch, .Rows(2), 0)
    If IsNumeric(vntRet) Then
      lngLast = Application.Max(5, .Cells(.Rows.Count, 1).End(xlUp).Row)
      On Error Resume Next
      Set rng = .Range(.Cells(5, vntRet - 1), .Cells(lngLast, vntRet + 1)).SpecialCells(xlCellTypeVisible)
      On Error GoTo 0
      If Not rng Is Nothing Then
        For Each rngRow In rng.Rows
          If Application.Sum(rngRow) = 0 Then
            If rngDelete Is Nothing Then
              Set rngDelete = rngRow.EntireRow
            Else
              Set rngDelete = Union(rngDelete, rngRow.EntireRow)
            End If
          End If
        Next
      End If
    End If
  End With
  
  If Not rngDelete Is Nothing Then rngDelete.Delete
  
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'deleteEmptyRows'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set rng = Nothing
  Set rngRow = Nothing
  Set rngDelete = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: Veränderliche Spalten durchsuchen
16.08.2012 08:22:02
Peter
Hallo Sepp,
vielen Dank für deine schnelle Antwort! Vorab: Es soll natürlich 2013 heißen und nicht 2015 ;)
Ich habe den Code von dir mal ausprobiert, aber leider ist bei mir überhaupt nichts passiert. Da ich ein völliger VBA-Neuling bin, kann ich den Code auch nicht nachvollziehen (sieht auf jeden Fall kompliziert aus).
Was ich vielleicht falsch beschrieben habe ist, dass alle Zeilen gelöscht werden sollen bei denen gleichzeitig bei E, I, S nichts drinne steht. Ich habe fälschlicherweise Null geschrieben. Könnte das eventl. der Fehler sein? Wenn dem so ist, muss ich dann überall wo eine 0 steht "" einsetzen?
Hat es denn bei dir funktioniert?
Kann ich irgendwas falsch gemacht haben oder muss ich irgendwas beachten?
LG Peter
Anzeige
AW: Veränderliche Spalten durchsuchen
16.08.2012 08:29:52
Josef

Hallo Peter,
in deiner Datei funktioniert es bei mir und es ist egal ob 0 oder "" in den Zellen steht.
Entspricht den die Datei dem Original? Vor allem die Zeile 2 ist wichtig!

« Gruß Sepp »

AW: Veränderliche Spalten durchsuchen
16.08.2012 09:04:16
Peter
Hallo Sepp,
ja ich benutze die Originaldatei, aber bei mir funktioniert es trotzdem nicht. ich hab einfach mal mitm Snipping Tool was ausgeschnitten damit du sehen kannst, das ich die Datei benutze und deinen Code eingefügt habe. Der Code sollte dabei ja eigentlich erkennen, dass die drei Zellen unter E,I, S leer sind (blau markiert) und damit die ganze Zeile gelöscht werden kann (rot markiert). Also müssten die Zeilen 6 und 13 gelöscht werden. Bei mir tut sich aber gar nichts. Vielleicht bin ich auch einfach nur zu doof ;)
Userbild
LG Patrick
Anzeige
AW: Veränderliche Spalten durchsuchen
16.08.2012 09:16:32
Josef

Hallo Peter,
"... bis 2015" der Code sucht aber nach "... bis 2013"!

« Gruß Sepp »

AW: Veränderliche Spalten durchsuchen
16.08.2012 12:47:29
Peter
Hallo Sepp,
da lag mein Fehler!!! Vielen vielen Dank!
Könnte man das ganze auch koppeln, im Sinne von: "Wenn die entsprechende Zeile gelöscht wird, dann lösche auch die dadrunter liegenden (gruppierten...also durch so ein Plus aufklappbar) 5 Zeilen".
Ist so etwas möglich?
Vielen Dank nochmal!
Gruß Peter
Anzeige
AW: Veränderliche Spalten durchsuchen
16.08.2012 13:02:20
Josef

Hallo Peter,
ungetestet!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub deleteEmptyRows()
  Dim rng As Range, rngRow As Range, rngDelete As Range
  Dim vntRet As Variant
  Dim strSearch As String
  Dim lngCalc As Long, lngLast As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  strSearch = "Gesamt*" & Year(Date) - 1 & "*" & Year(Date) & "*" & Year(Date) + 1
  
  With ActiveSheet
    vntRet = Application.Match(strSearch, .Rows(2), 0)
    If IsNumeric(vntRet) Then
      lngLast = Application.Max(5, .Cells(.Rows.Count, 1).End(xlUp).Row)
      On Error Resume Next
      Set rng = .Range(.Cells(5, vntRet - 1), .Cells(lngLast, vntRet + 1)).SpecialCells(xlCellTypeVisible)
      On Error GoTo 0
      If Not rng Is Nothing Then
        For Each rngRow In rng.Rows
          If Application.Sum(rngRow) = 0 Then
            If rngDelete Is Nothing Then
              Set rngDelete = rngRow.Resize(5, 1).EntireRow
            Else
              Set rngDelete = Union(rngDelete, rngRow.Resize(5, 1).EntireRow)
            End If
          End If
        Next
      End If
    End If
  End With
  
  If Not rngDelete Is Nothing Then rngDelete.Delete
  
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'deleteEmptyRows'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set rng = Nothing
  Set rngRow = Nothing
  Set rngDelete = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: Veränderliche Spalten durchsuchen
16.08.2012 17:51:35
Peter
Hallo Sepp,
danke das hat super funktioniert.
LG Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige