Herbers Excel-Forum - das Archiv

Bewerten Sie hier bitte das Excel-Portal

Spalten nach Kriterium über merhere Tabellen lösch

Bild

Betrifft: Spalten nach Kriterium über merhere Tabellen lösch
von: doey

Geschrieben am: 18.12.2006 00:04:04
Hi,
hoffe Ihr könnt mir helfen...
Versuche über mehrere Tabellenblätter, alle Spalten die z. B. in der 4. zeile den Wert 0 haben, zu löschen!
Ich habe hier ein Skript was das schon bewältigt!
Das was mich nervt ist, dass wenn z. B. 50 Tabellenblätter abgearbeitet werden sollen, dass ziemlich lange dauert.
Also mir geht es darum, das Skript so anzupassen, dass es im Nu abgearbeitet ist!
Vielleicht hat ja jemand eine Idee?!?
hier das gebastelte Skript:
Sub SpaltenNachKriteriumLöschen()
Dim c As Long, cz As Long
cz = Range("IV4").End(xlToRight).Column
For a = 2 To Sheets.Count
For c = cz To 1 Step -1
If Sheets(a).Cells(4, c).Value = "0" Then
Sheets(a).Columns(c).Delete
End If
Next c
Next a
End Sub

Gruß doey
Bild

Betrifft: AW: Spalten nach Kriterium über merhere Tabellen lösch
von: Daniel Eisert

Geschrieben am: 18.12.2006 02:06:47
Hallo
Folgende möglichkeit, geht aber nur, wenn in den Zeile 4 keine Leerzellen enthalten sind (diese werden mit gelöscht)
Das ganze basiert darauf, daß die 0-Werte durch Leerzellen ersetzt werden.
Diese Leerzellen können von Excel gezielt selekiert werden (entspricht BEARBEITEN-GEHE Zu-INHALTE-LEERZELLEN.
Dadurch entfällt die zeitaufwendige For-Schleife.
Sub Makro2()
Dim a As Long
For a = 2 To Sheets.Count
With Sheets(a).Rows(4)
.Formula = .Value
On Error Resume Next
.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
.SpecialCells(xlCellTypeConstants, 23).Formula = "Hier deine Formel eintragen)"
On Error GoTo 0
End With
Next
End Sub

Wenn die Zeile 4 keine Formeln, sondern Konstant-Werte entält, sieht der Code so aus:
Sub Makro2()
Dim a As Long
For a = 2 To Sheets.Count
With Sheets(a).Rows(4)
On Error Resume Next
.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
On Error GoTo 0
End With
Next
End Sub

Gruß, Daniel
Bild

Betrifft: AW: Spalten nach Kriterium über merhere Tabellen l
von: doey
Geschrieben am: 18.12.2006 15:48:45
Hi Daniel,
danke für deine Antwort.
Leider kommen in der Zeile 4 auch Leerzeilen vor, die dann auch gelöscht werden!
Trotzdem ist es ein interessanter Ansatz.
Gruß doey
Bild

Betrifft: AW: Spalten nach Kriterium über merhere Tabellen l
von: Daniel Eisert

Geschrieben am: 18.12.2006 22:18:44
Hallo
du kannst natürlich auch anstelle des "Blanks" einen Wahrheitswert (WAHR/FALSCH) in die Zellen mit 0 schreiben.
diese Wahrheitswerte kannsst du mit SpecialCells dann genausso selekieren wie die Leerzellen.
Wie es genau geht, kannst du am einfachsten mit dem Makro-Rekorder und der Hilfe rausfinden. (über Berarbeiten - Gehe zu - usw.)
Andere Alternative wäre, auf dem gleichen Weg erst die Leerzellen mit "xxx" oder was ähnlichem zu befüllen, dann wie beschrieben die Spalten mit 0-Werten löschen und dann die "xxx" wieder durch Blanks zu ersetzen.
Möglichkeiten gibts viele.
Gruß, Daniel
Bild

Betrifft: AW: Spalten nach Kriterium über merhere Tabellen l
von: doey
Geschrieben am: 20.12.2006 00:31:04
hast mir sehr geholfen!
Danke :)
doey
 Bild
Excel-Beispiele zum Thema "Spalten nach Kriterium über merhere Tabellen lösch"
Vorkommen von Zahlenreihen in Spalten Funktion ANZAHL2 ohne ausgeblendete Spalten
Spaltenbreite anpassen Spalten einer Mehrbereichsauswahl ausblenden.
Spaltennamen bestimmen Spalten/Zeilen aus- und einblenden
Zeilen und Spalten über ein Drehfeld ein- und ausblenden In einem Dialog ausgewählte Spalten drucken
Spalten bedingt summieren und Zellen formatieren Abfrage der markierten Spalten