Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
988to992
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
988to992
988to992
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Schnelleres ausführen eines Makros

Schnelleres ausführen eines Makros
29.06.2008 13:10:00
Alex
Folgendes Problem:
Mein makro sucht in gewissen Zellen nach einem Wert.
Dieser Wert ist ausschlaggebend darüber, ob eine Zeile angezeigt
werden soll oder nicht.
Die Ausführung meiens Makros dauert leider für mich zu lange, ca. 14 Sekunden.
Wie kann man dies beschleunigen?
Wer kann mir helfen?
Danke
Alex
Hier mein Makro:

Sub Zeilen()
Dim Zelle
Application.ScreenUpdating = False
For Each Zelle In Range("bi3:bi299")
ActiveSheet.Unprotect
If Zelle.Value = 2 Then
Zelle.EntireRow.Hidden = True
Else
ActiveSheet.Unprotect
Zelle.EntireRow.Hidden = False
End If
Next
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
End Sub


8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schnelleres ausführen eines Makros
29.06.2008 13:18:51
{Boris}
Hi Alex,
probier mal:

Option Explicit
Sub ausblenden()
Dim C As Range
GetMoreSpeed
ActiveSheet.Unprotect
For Each C In Range("BI3:BI299")
Rows(C.Row).Hidden = C = 2
Next C
ActiveSheet.Protect
GetMoreSpeed 0
End Sub
Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long
With Application
If Modus = 1 Then
lngCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = -4135
.Cursor = xlWait
Else
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = IIf(lngCalc > 0, lngCalc, -4105)
.Cursor = xlDefault
End If
End With
End Sub


Grüße Boris

Anzeige
AW: Schnelleres ausführen eines Makros
29.06.2008 13:47:18
ransi
HAllo
Alternative zu GetMooreSpeed:
Sammel erst alle Zellen in einem Bereich.
Zum Schluss den gesamten Bereich aufeinmal ausblenden.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit


Public Sub test()
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Range("BI65536")
For Each Zelle In Range("BI2:BI229")
    If Zelle.Value = 2 Then Set Bereich = Union(Bereich, Zelle)
Next
Bereich.EntireRow.Hidden = True
End Sub

ransi

Anzeige
AW: Schnelleres ausführen eines Makros
29.06.2008 13:59:00
Reinhard
Hallo Rainer,
ich nehme an du meintest das so:

Public Sub Zeilen3()
Dim Bereich As Range
ActiveSheet.Unprotect
Set Bereich = Range("BI3")
For Each Zelle In Range("BI4:BI229")
If Zelle.Value = 2 Then Set Bereich = Union(Bereich, Zelle)
Next
Bereich.EntireRow.Hidden = True
End Sub


Gruß
Reinhard

AW: Schnelleres ausführen eines Makros
29.06.2008 14:12:57
ransi
Hallo Rainhard
Set Bereich =Range("BI65536") war schon richtig.
Allerdings hab ich mich hier vertan:
For Each Zelle In Range("BI2:BI229")
Hier nochmal der korrigierte Code:
Option Explicit

Public Sub test()
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Range("BI65536")
For Each Zelle In Range("BI3:BI229")
    If Zelle.Value = 2 Then Set Bereich = Union(Bereich, Zelle)
Next
Bereich.EntireRow.Hidden = True
End Sub


BI65536 sollte eine Zelle sein die nicht gebraucht wird.
Wenn ich keine Zelle in Bereich festlege läuft das erste Union in einen Fehler.
ransi

Anzeige
AW: Schnelleres ausführen eines Makros
29.06.2008 14:35:00
Reinhard
Hallo Ransi,
dann wegen dem Hinweis von Boris mit B65536 dann doch ggfs. so:

Public Sub Zeilen3()
Dim Zelle As Range, Bereich As Range
ActiveSheet.Unprotect
Set Bereich = Range("A1")
For Each Zelle In Range("BI3:BI229")
If Zelle.Value = 2 Then Set Bereich = IIf(Bereich.Address(0, 0)  "A1", Union(Bereich,  _
Zelle), Zelle)
Next
If Bereich.Address(0, 0)  "A1" Then Bereich.EntireRow.Hidden = True
End Sub


Gruß
Reinhard

Und dann noch mit der Find-Methode...
29.06.2008 14:12:00
{Boris}
Hi Ransi,
...dann ist es noch flotter:

Option Explicit
Sub til()
Dim newRange As Range
Dim oldRange As Range
Dim C As Range
Dim firstAddress As String
Set oldRange = Range("BI2:BI299")
With oldRange
Set C = .Find(2, lookat:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
Do
If newRange Is Nothing Then
Set newRange = C
Else
Set newRange = Union(newRange, C)
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address  firstAddress
End If
End With
newRange.EntireRow.Hidden = True
End Sub


Ich würde den Union-Bereich nicht mit einer Zelle aus Zeile 65000 vorbelegen, da dadurch der UsedRange (und somit auch die Mappengröße) enorm anschwillt.
Grüße Boris

Anzeige
AW: Und dann noch mit der Find-Methode...
29.06.2008 14:27:00
ransi
HAllo Boris
Ich würde den Union-Bereich nicht mit einer Zelle aus Zeile 65000 vorbelegen, da dadurch der UsedRange (und somit auch die Mappengröße) enorm anschwillt.,
Hast uneingeschränkt recht mit deinem Enwand.
So sollte das aus der Welt sein: ;-)

Set Bereich = Range("BI65536").End(xlUp).Offset(1, 0)


ransi

AW: Und dann noch mit der Find-Methode...
29.06.2008 14:48:00
Alex
Vielen Dank an Boris, Reinahrd und Ransi,
ich hatte nicht damit gerechnet, dass
mein Beitrag s reges Interesse und Unterstützung auslösen würde.
Vielen Dank es hat gut funktioniert.
Gruß
Alex
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige