Zellen schnell mit VBA ausblenden

[Marc H.]

Hallo Leute,

ich habe ein kleines Problem in VBA.

Ich überberprüfe ca. 5000 Zeilen ob in einer etwas drinsteht. Wenn nein soll
die Zeile ausgeblendet werden.

for z = 1 to 5000

a = Cells(z, 1)

If a = 0 Then
Rows(t).Hidden = True
End If

next z

Läuft auch wunderbar dauert nur elend lange.

Hätte einer von euch einer einen Optimierungsvorschlag?

Ganz lieben Dank.

Gruß

Marc

[Andreas Killer]

On 2 Dez., 11:39, "Marc H." <mar...@nospam-bitte.de> wrote:

> Läuft auch wunderbar dauert nur elend lange.

Ich weiß ja nicht wo Du t initialisierst, bei mir gäbe das einen
Fehler. .-)

> Hätte einer von euch einer einen Optimierungsvorschlag?

Sub Test()
Application.ScreenUpdating = False
For z = 1 To 5000
If Cells(z, 1) = 0 Then Rows(z).Hidden = True
Next
Application.ScreenUpdating = True
End Sub

Noch schneller wird's wenn Du ggf. Bereiche gruppieren kannst und dann
mehrere Zeilen auf einmal ausblendest, ala Rows("23:450").Hidden =
True. Die Frage ist ob das überhaupt möglich wäre?.

Aber das kriegst Du bestimmt alleine hin, oder?

Andreas.

[Reimund L]

Hi Marc,

Vielleicht so ein bisschen schneller:

application.screenupdating=false

for z = 1 to 5000

if isempty(cells(z,1).value) then
rows(z).hidden=true
end if
next
application. screenupdating=true

(ungetestet)

Gruss Reimund

"Marc H." <mar...@nospam-bitte.de> schrieb im Newsbeitrag
news:e2ucTpGV...@TK2MSFTNGP06.phx.gbl...

[Claus Busch]

Hallo Andreas, hallo Marc,

Am Tue, 2 Dec 2008 03:12:55 -0800 (PST) schrieb Andreas Killer:

> Application.ScreenUpdating = False
> For z = 1 To 5000
> If Cells(z, 1) = 0 Then Rows(z).Hidden = True
> Next
> Application.ScreenUpdating = True

es geht auch ohne die If-Abfrage:

Application.ScreenUpdating = False
For i = 1 To 5000
Rows(i).Hidden = Cells(i, 1).Value = ""
Next
Application.ScreenUpdating = True

Mit freundlichen Grüssen
Claus Busch
--
Win XP Prof SP3 / Vista Ultimate
Office 2003 SP3 / 2007 Ultimate SP1

[Wolfgang Habernoll]

Hallo

"Marc H." <mar...@nospam-bitte.de> schrieb im Newsbeitrag
news:e2ucTpGV...@TK2MSFTNGP06.phx.gbl...

versuche es mal so

Range("A1:A40").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

ggf. noch den Fehler abfangen wenn keine leeren Zellen mehr da sind.

--
mfG
Wolfgang Habernoll

[ Win XP Home SP-2 , XL2002 ]

[Wolfgang Habernoll]

Hallo

ich noch mal

> versuche es mal so
>
> Range("A1:A40").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
>
> ggf. noch den Fehler abfangen wenn keine leeren Zellen mehr da sind.

natürlich den Bereich anpassen
Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[Andreas Killer]

Wolfgang Habernoll schrieb:

> Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Öhm, Einspruch. :-))

Die Idee ist gut, aber er möchte gerne ausblenden, nicht löschen, was
dann zu
Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
würde, was aber nicht geht.

Wieso eigentlich nicht?

Andreas.

[Thomas Ramel]

Grüezi Andreas

Andreas Killer schrieb am 02.12.2008

> Wolfgang Habernoll schrieb:
>
>> Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
> Öhm, Einspruch. :-))

...stattgegeben... ;-)

> Die Idee ist gut, aber er möchte gerne ausblenden, nicht löschen, was
> dann zu
> Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
> würde, was aber nicht geht.

Was geht denn nicht - wie hast Du getestet?

> Wieso eigentlich nicht?

SpecialCells kennt zwei Einschränkungen:

- Im Bereich müssen irgendwo Daten vorhanden sein, also nicht alles leer

- nicht mehr als 8125 unzusammenhängende Bereiche als Ergebnis resultieren

Dann aber klappt das damit hervorragend und sehr schnell.

Mit freundlichen Grüssen
Thomas Ramel

--
- MVP für Microsoft-Excel -
[Win XP Pro SP-2 / xl2003 SP-3]
Microsoft Excel - Die ExpertenTipps

[Marc H.]

Hallo!!!

Ist ja Wahnsinn. Danke erstmal an alle.

Ich habe die Lösung von Andreas umgesetzt. Ist rattenschnell.

Was ich noch nicht verstehe ist, dass ich das Phaenomen habe, dass es ab und
zu, wenn ich es mehrmals hintereinander verstecke und wieder sichbar mache,
das Hiden doch extrem lange brauch.

Aber sonst ist es unglaublich.

Danke noch mal.

Gruß
Marc

[Wolfgang Habernoll]

Hallo Andreas

"Andreas Killer" <andreas...@gmx.net> schrieb im Newsbeitrag
news:49356704$1...@news.arcor-ip.de...

> Wolfgang Habernoll schrieb:
>
>> Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
> Öhm, Einspruch. :-))
>
> Die Idee ist gut, aber er möchte gerne ausblenden, nicht löschen, was dann zu

ja, das hab ich nicht richtig gelesen :-(

> Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
> würde, was aber nicht geht.
>
> Wieso eigentlich nicht?

aber das geht doch genau so wie du es umgesetzt hast. Allerdings muß mindest eine
Zelle Blank sein, sonst kommt der Laufzeitfehler 1004 keine Zelle gefunden.

[Andreas Killer]

Wolfgang Habernoll schrieb:

>> Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

>> würde, was aber nicht geht.

> aber das geht doch genau so wie du es umgesetzt hast. Allerdings muß mindest eine
> Zelle Blank sein, sonst kommt der Laufzeitfehler 1004 keine Zelle gefunden.

Aha, siehste da haben wir den Haken.

Ich hatte zwar von A1 bis A5 in jeder Zelle was drin und trotzdem kam
der Fehler!

SpecialCells macht sich den Bereich offenbar selbst und kuckt nicht bis
A5000 wie programmiert. SpecialSpecialCellsFeature. %-)

Wenn ich mal mit
Adresse = Cells.SpecialCells(xlCellTypeLastCell).Address
mir die Adresse hole, dann ist diese in meinem Test nämlich $A$5.

Ich hab's mit XL 2002 probiert, also haut mich nicht wenn's bei euch
geht. .-)

Andreas.

[Wolfgang Habernoll]

Hallo Andreas

"Andreas Killer" <andreas...@gmx.net> schrieb im Newsbeitrag

news:4936bbef$1...@news.arcor-ip.de...

> Wolfgang Habernoll schrieb:
>
>>> Range("A1:A5000").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

>>> w�rde, was aber nicht geht.
>> aber das geht doch genau so wie du es umgesetzt hast. Allerdings mu� mindest eine

>> Zelle Blank sein, sonst kommt der Laufzeitfehler 1004 keine Zelle gefunden.
> Aha, siehste da haben wir den Haken.
>
> Ich hatte zwar von A1 bis A5 in jeder Zelle was drin und trotzdem kam der Fehler!
>
> SpecialCells macht sich den Bereich offenbar selbst und kuckt nicht bis A5000 wie
> programmiert. SpecialSpecialCellsFeature. %-)
>
> Wenn ich mal mit
> Adresse = Cells.SpecialCells(xlCellTypeLastCell).Address

> mir die Adresse hole, dann ist diese in meinem Test n�mlich $A$5.

>
> Ich hab's mit XL 2002 probiert, also haut mich nicht wenn's bei euch geht. .-)

nee, wir hauen nicht. In der Tat, SpecialCells nimmt nur den UsedRange auch wenn Range
gr��er definiert wird. Aber f�r deinen Fall k�nnte man ja ein wenig tricksen. ;-) ist
in jedem Fall noch schneller als Schleifen.

With Cells(5000, 1)
.Interior.ColorIndex = .Interior.ColorIndex
Range("A1:A" & .Row).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End With

mich w�rde ja noch interessieren welche "L�sung von Andreas umgesetzt. Ist
rattenschnell." der OP meint, deine Code oder die Korrektur von Delete.

[michael himmelstoss]

Hallo NG,

folgenden Code habe ich in diesem Post gefunden.

With Cells(5000, 1)
.Interior.ColorIndex = .Interior.ColorIndex
Range("A1:A" & .Row).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End With

Ich würde diesen gerne so modifizieren, dass Excel 2007 folgendes macht:

Fange an bei Zelle A2 und gehe dann bis zur ersten grau formatierten Zelle.
Gruppiere die Zeilen die drüber liegen.
Gehe dann wieder weiter zur nächsten weiss formatierten Zelle usw.
Das ganze bis zum Ende der Tabelle.
Ergebnis ist eine einfache Gruppierung mit nur Grauen Zeilen sichtbar.

Hat da jemand eine einfache Lösung dafür? Ich bin leider in VBA nicht so fit sondern habe nur Grundkenntnisse.


Für jede Hilfe dankbar ist.
Michael

[Claus Busch]

Hallo Michael,

Am Tue, 15 Oct 2013 08:59:53 -0700 (PDT) schrieb michael himmelstoss:

> Fange an bei Zelle A2 und gehe dann bis zur ersten grau formatierten Zelle.

> Gruppiere die Zeilen die dr�ber liegen.
> Gehe dann wieder weiter zur n�chsten weiss formatierten Zelle usw.

> Das ganze bis zum Ende der Tabelle.
> Ergebnis ist eine einfache Gruppierung mit nur Grauen Zeilen sichtbar.

die letzte Zelle muss dann aber auch grau sein. Probiers mal so:

Sub Test()
Dim LRow As Long
Dim i As Long
Dim Start As Long

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
Start = 2
For i = Start To LRow + 1
If Cells(i, 1).Interior.ColorIndex = 15 Then
Rows(Start & ":" & i - 1).Group
Start = i + 1
End If
Next
End With
End Sub

Falls das nicht geht, �berpr�fe mal den ColorIndex deiner grauen Farbe
und �ndere ihn im Code


Mit freundlichen Gr��en
Claus
--
Win XP Prof SP3 / Vista Ultimate SP2
Office 2003 SP3 /2007 Ultimate SP3

[michael himmelstoss]

Hallo Claus,

vielen Dank für den Code und die schnelle Antwort (Ich verstehe leider nur die Hälfte). Er funktioniert soweit, allerdings gibt es zwei Besonderheiten.

Wenn zwei graue Zeilen (Zellen) untereinanderstehen wird die Gruppierung ignoriert und es wird erst wieder bei der nächsten Einzeiligen grauen Formatierung Gruppiert. Bei 3 grauen Zeilen ergibt sich eine neue (3.) Ebene.

Ich weiss, das hatte ich so nicht spezifiziert. Könntest Du das noch einbauen?
Wenns zu kompliziert wird, kann ich auch damit leben.

Vielen Dank
Michael

[Claus Busch]

Hallo Michael,

Am Wed, 16 Oct 2013 02:31:32 -0700 (PDT) schrieb michael himmelstoss:

> Wenn zwei graue Zeilen (Zellen) untereinanderstehen wird die Gruppierung ignoriert und es wird erst wieder bei der n�chsten Einzeiligen grauen Formatierung Gruppiert. Bei 3 grauen Zeilen ergibt sich eine neue (3.) Ebene.

> Ich weiss, das hatte ich so nicht spezifiziert.

probiers mal so:

Sub Test()
Dim LRow As Long
Dim i As Long

Dim n As Integer
Dim Start As Long
Dim c As Range

Application.FindFormat.Interior.ColorIndex = xlNone
With ActiveSheet
Start = 2
i = 2
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
Do

If Cells(i, 1).Interior.ColorIndex = 15 Then
Rows(Start & ":" & i - 1).Group

With .Range("A1:A" & LRow)
If i < LRow Then
Set c = .Find("", after:=.Range("A" & i), _
searchorder:=xlByRows, searchformat:=True)
Start = c.Row
End If
End With
End If
i = WorksheetFunction.Max(i + 1, Start + 1)
Loop While i < LRow + 2
End With
End Sub

[michael himmelstoss]

Hallo Claus,

nochmal vielen Dank für die schnelle Umsetzung. In meiner Testdatei hatte ich zwar jetzt 5 Ebenen, was aber in manchen Fällen sogar besser ist.

Bin begeistert. Und wenn ich mich noch bissl reinfuchse, dann kann ich das vielleicht auch noch anpassen, je nach Anforderung (Gruppierebenen).

Viele Grüße
Michael

[Claus Busch]

Hallo Michael,

Am Wed, 16 Oct 2013 08:44:21 -0700 (PDT) schrieb michael himmelstoss:

> In meiner Testdatei hatte ich zwar jetzt 5 Ebenen, was aber in manchen F�llen sogar besser ist.

also ich habe nur 2 Ebenen in meiner Mappe. Hast du vielleicht noch
etwas nicht beschrieben oder hast du eventuell schon vorhandene
Gliederungen nicht entfernt?

[michael himmelstoss]

Hallo Claus,

Schon vorhandene Ebenen habe ich keine drin. Was ich vielleicht nicht beschrieben habe ist, dass bei manchen Zwischensummen zwei oder drei Zellen grau sind. Und am Ende sind es in meinem Beispiel vier Zellen, da Zwischensumme und Gesamtsumme dargestellt sind.

Viele Grüße
Michael