Anzeige
Archiv - Navigation
188to192
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
188to192
188to192
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zeilen nach best. Kriterium ausblenden ?

Zeilen nach best. Kriterium ausblenden ?
11.12.2002 14:14:35
Peter
Hallo zusammen !
Ich habe eine Kalkulation mit etwa 2000 Zeilen erstellt. In Spalte B werden die Bestellmengen eingegeben. Nun möchte ich eine Funktion haben, die alle Zeilen (von 1 bis 2000) ausblendet in denen keine Bestellmenge eingegeben wurde. D.h. die Felder sind leer. Zusätzlich soll die Funktion die Felder daraufhin untersuchen, ob das jeweilige Feld mit dem Colorindex 35 belegt ist. D.h. nur wenn das jeweilige Feld (in Spalte B) mit dem Colorinde 35 belegt ist und kein Eintrag erfolgt ist, soll die ganze Zeile ausgeblendet werden.

Bisher habe ich ein Makro geschrieben, welches jede Zelle (von B1 bis B2000) auf diese Kriterien untersucht und dann ausblendet. Das Makro funktioniert auch soweit. Es hat nur einen großen Nachteil. Da die Zellen quasi manuell durch das Makro abgeprüft werden dauert diese Selektion unendlich lange. Hat jemand eine Idee, wie man mein Problem lösen könnte ?

Danke

Peter

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Zeilen nach best. Kriterium ausblenden ?
11.12.2002 14:43:50
L.Vira
wo ist dein Code?
Hier nun der bisherige Code...
11.12.2002 14:48:35
peter
Anbei der Code:
Sub Kurzfunktion_Zukauf()
Dim c As Variant
Dim Zaehler As Double
Dim Zaheler2 As Double
Zaehler = 0
Zaheler2 = 0
'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'Arbeitsblatt Zukauf wählen
Worksheets("Zukauf").Select
'Letzte Zelle in Spalte B wählen
Range("b65536").Select
'Hochspringen bis letzte beschriebene Zeile gefunden
Selection.End(xlUp).Select
Range(ActiveCell.Address, "b7").Select
Zaehler = Selection.Rows.Count
Weitere_Optionen.Caption = "In Arbeit: 0,0000 %//"
Range("b65536").Select
'Hochspringen bis letzte beschriebene Zeile gefunden
Selection.End(xlUp).Select
'Schleifenprogrammierung um überzählige Zeilen auszublenden
'Zieladresse für Schluss: B7
While ActiveCell.Address <> Range("b7").Address
'Wenn aktive Zelle leer ist
If ActiveCell.Text = Empty Or ActiveCell.Text = Null Then
'Wenn aktive Zelle türkis eingefärbt ist
If ActiveCell.Interior.ColorIndex = 35 Then
'dann blende Zeile aus
Selection.EntireRow.Hidden = True
'sonst nix
Else
End If
'sonst nix
Else
End If
'Springe in die darübergelegene Zeile
ActiveCell.Offset(-1, 0).Activate
Zaehler2 = Round(Zaehler2, 4) + Round((100 / Zaehler), 4)
Weitere_Optionen.Caption = "//SLF// In Arbeit: " & Zaehler2 & " %"
Weitere_Optionen.Repaint
Wend
'Bildschirmaktualisierung aktivieren
Application.ScreenUpdating = True
'Auf Temporär Auswahl auf 0 setzen
Worksheets("Temporär").Range("c1").Value = 0
Weitere_Optionen.Caption = "Weitere Optionen//"
End Sub
Anzeige
Re: Hier nun der bisherige Code...
11.12.2002 14:57:49
Steffen D
Hi,

probier mal diesen code:

Sub Kurzfunktion_Zukauf()
Dim c As Variant
Dim Zaehler As Double
Dim Zaheler2 As Double
Zaehler = 0
Zaheler2 = 0
'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'Arbeitsblatt Zukauf wählen
Worksheets("Zukauf").Activate
'Hochspringen bis letzte beschriebene Zeile gefunden
Range(Range("B65536").End(xlUp).Address, "B7").Select
Zaehler = Selection.Rows.Count
Weitere_Optionen.Caption = "In Arbeit: 0,0000 %//"
Range("B65536").End(xlUp).Activate
'Schleifenprogrammierung um überzählige Zeilen auszublenden
'Zieladresse für Schluss: B7
While ActiveCell.Address <> Range("B7").Address
'Wenn aktive Zelle leer ist
If ActiveCell.Text = Empty Or ActiveCell.Text = Null Then
'Wenn aktive Zelle türkis eingefärbt ist
If ActiveCell.Interior.ColorIndex = 35 Then
'dann blende Zeile aus
ActiveCell.EntireRow.Hidden = True
End If
End If
'Springe in die darübergelegene Zeile
ActiveCell.Offset(-1, 0).Activate
Zaehler2 = Round(Zaehler2, 4) + Round((100 / Zaehler), 4)
Weitere_Optionen.Caption = "//SLF// In Arbeit: " & Zaehler2 & " %"
Weitere_Optionen.Repaint
Wend
'Bildschirmaktualisierung aktivieren
Application.ScreenUpdating = True
'Auf Temporär Auswahl auf 0 setzen
Worksheets("Temporär").Range("C1").Value = 0
Weitere_Optionen.Caption = "Weitere Optionen//"
End Sub

Gruß
Steffen D

Anzeige
Re: Hier nun der bisherige Code...
11.12.2002 14:59:01
L.Vira
Dass das dauert, liegt daran, dass du selectest, das ist nicht nötig! Hier mal nur die Ausblendaktion:

Option Explicit
Sub ausblenden_wenn()
Dim Z As Long, lZ As Long
lZ = [b65536].End(xlUp).Row
For Z = lZ To 1 Step -1
If Cells(Z, 2) = "" And _
Cells(Z, 2).Interior.ColorIndex = 35 Then
Rows(Z).RowHeight = 0
End If
Next
End Sub

Re: Hier nun der bisherige Code...
11.12.2002 15:04:19
Peter
Vielen Dank Euch beiden !!!
Werde es ausprobieren !!!
Re: Hier nun der bisherige Code...
11.12.2002 15:34:53
Martin Beck
Hallo,

evtl. läßt sich die Performance noch steigern, wenn nicht alle, sondern nur alle leere Zellen auf den Colorindex geprüft werden.

Gruß
Martin Beck

Anzeige
Re: Hier nun der bisherige Code...
11.12.2002 16:07:48
L.Vira
Das bringt keinen meßbaren zeitgewinn,erst:
Application.ScreenUpdating = False
verringert die zeit drastisch!Probiers aus.
Re: Hier nun der bisherige Code...
11.12.2002 16:29:30
Martin Beck
Hallo,

1. Application.ScreenUpdating = False war ja in dem ursprünglichen Makro schon gesetzt, Ich bin natürlich davon ausgegangen, daß entweder Dein oder mein Codeschnipsel in den bestehenden Code eingebaut wird.

2. Die Performancesteigerung hängt m.E. von der Zahl der zu durchlaufenden Zeilen im Verhältnis zu der Zahl der Zeilen mit leeren Zellen ab. Bei 2000 Zeilen ist das sicher kein Problem, bei 60000 schon.

3. Es kam mir darauf an, nochmal deutlich zu machen (auch für Archiv/Recherche), daß SpecialCells in bestimmten Situationen Vorteile gegenüber Schleifen hat. In diesem Fall besteht er darin, die Zahl der zu prüfenden Zellen zu reduzieren.

Gruß
Martin Beck

Anzeige
Vielen Dank !!!
11.12.2002 16:34:03
Peter
Hallo vielen Dank Euch allen !!!
Auf jeden Fall sind Eure Codes deutlich schneller als meine.
Ich habe den Code nun entsprechend angepasst.

Vielen Dank nochmals

Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige