Spalten löschen nach Prüfung einer Zelle

Hallo zusammen,
ich habe folgendes, für mich leider kniffliges, Problem:
Ich möchte gerne das in einem bestimmten Arbeitsblatt ("ÜBERSICHT") geprüft wird ob
der Wert in Zelle (1, O) = 0 ist.
(Dieser Wert 0 entsteht aus einem anderen Arbeitsblatt. Ist dort in einer bestimmten Zelle ein Text eingetragen erscheint dieser auch in der Zelle (1, O). Ist dort eben kein Text eingetragen zeigt Zelle (1, O) 0 an.)
Sollte das der Fall sein, sollen die Spalten K bis T gelöscht werden.
Das ganze soll dann insgesamt 7 mal wiederholt werden:
- wenn Zelle (1, Y) = 0 sollen Spalten U bis AD gelöscht werden
- wenn Zelle (1, AI) = 0 sollen Spalten AE bis AN gelöscht werden
usw..
Hoffe wie immer auf Eure Hilfe.
Vielen Dank& Gruss, pan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

With Sheets("ÜBERSICHT") If .Range("O1").Value = 0 Then .Range("K1:T1").EntireColumn.ClearContents If .Range("Y1").Value = 0 Then .Range("U1:AD1").EntireColumn.ClearContents If .Range("AI1").Value = 0 Then .Range("AE1:AN1").EntireColumn.ClearContents End With

Sub CallMany() With Sheets("ÜBERSICHT") Call ZehnSpalten(.Range("O1")) Call ZehnSpalten(.Range("Y1")) Call ZehnSpalten(.Range("AI1")) End With End Sub Sub ZehnSpalten(myRange As Range) If myRange.Value = 0 Then myRange.Offset(0, -4).Resize(1, 10).EntireColumn.ClearContents End If End Sub

Hallo,
kannst mal so testen.

Sub test()
Dim rng As Range, rngTmp As Range, rngLoesch As Range
Dim ArDaten
Dim n%

'Prüfe Spalte, Lösche Spalte, Prüfe Spalte, lösche Spalte, ... 
ArDaten = Array(15, "K:T", 25, "U:AD", 35, "AE:AN")

On Error GoTo ErrorHandler:
Events_ False
With Worksheets("Übersicht") 'Tabelle 
    'Hilfsspalte = letzte 
    Set rng = Intersect(.UsedRange.EntireRow, .Columns(.Columns.Count))
    For n = Lbound(ArDaten) To Ubound(ArDaten) Step 2
        Set rngTmp = .Range(ArDaten(n + 1))
        'Formel für Prüfung 
        rng.FormulaR1C1 = "=IF((RC" & ArDaten(n) & "=0)*(RC" & ArDaten(n) & "<>""""),1,"""")"
        If Application.WorksheetFunction.CountIf(rng, 1) > 0 Then
            Set rngLoesch = rng.SpecialCells(xlCellTypeFormulas, 1).EntireRow
            Set rngLoesch = Intersect(rngLoesch, rngTmp)
            rngLoesch.ClearContents 'nur Inhalt löschen 
'            rngLoesch.Clear 'alles löschen 
        End If
    Next n
    'Hilfsspalte löschen 
    rng.EntireColumn.Delete
End With

ErrorHandler:
Events_ True
If Err.Number <> 0 Then
    MsgBox Err.Number & vbCr & vbCr & Err.Description, vbCritical, "Fehler!"
End If
End Sub

Sub Events_(booSchalter As Boolean)
With Application
    .ScreenUpdating = booSchalter
    .EnableEvents = booSchalter
    .DisplayAlerts = booSchalter
    .Calculation = IIf(booSchalter, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Spalten löschen nach Prüfung einer Zelle

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

136 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten löschen nach Prüfung einer Zelle

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

136 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread