Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1764to1768
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
Inhaltsverzeichnis

Makro beschleunigen

Makro beschleunigen
14.06.2020 20:47:00
Marko
Hallo,
gibt es eine Möglichkeit dieses Makro zu beschleunigen? Aktuell braucht dieses Makro 32-34 Sekunden.
Vielen Dank im Voraus für ein Feedback hierzu.

Sub Berechnen ()
Dim Wiederholungen As Long
Application.ScreenUpdating = False
For Wiederholungen = 14 To 87
If Cells(Wiederholungen, 1).Value = "x" Then
Rows(Wiederholungen).Hidden = True
Else
Rows(Wiederholungen).Hidden = False
End If
Next
End Sub

27
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro beschleunigen
14.06.2020 20:48:12
Hajo_Zi
mache es ohne VBA, mit Autofilter.

AW: Makro beschleunigen
14.06.2020 21:01:18
onur
32-34 sec ? Was hast du denn für einen Rechner? Meiner braucht für dein Makro weniger als eine halbe Sekunde.
Hier etwas kürzer:
Sub Berechnen()
Dim Wiederholungen As Long
For Wiederholungen = 14 To 87
Rows(Wiederholungen).Hidden = Cells(Wiederholungen, 1).Value = "x"
Next
End Sub

AW: Makro beschleunigen
14.06.2020 21:15:34
Marko
Hallo,
Danke für das schnelle Feedback.
Leider wird es mit dem verkürzten Makro nicht schneller.
Mein Rechner: Dell Precision 5530 2-in-1
AW: Makro beschleunigen
14.06.2020 21:21:51
onur
Da hast du aber noch ganz andere Probleme - Meiner braucht 0,09375 s für den neuen Code.
Anzeige
AW: Makro beschleunigen
14.06.2020 21:26:10
Marko
Krass. Meinst du es liegt am Rechner?
AW: Makro beschleunigen
14.06.2020 21:28:10
onur
Keine Ahnung - wie bzw von welchen Makro aus rufst du denn den Code auf?
Muss ja nicht unbedingt an DIESEM Makro liegen.
AW: Makro beschleunigen
14.06.2020 21:33:24
Marko
Das ist das vollständige Makro, welches mit einem Button aktiviert wird.
Sub Abfrage()
Dim dteStart As Date, dteEnde As Date
Dim iCounter As Single
Application.ScreenUpdating = False
dteStart = Timer
For iCounter = 1 To 5000
If iCounter Mod 1000 = 0 Then
Application.StatusBar = _
"Besuche Zeile " & iCounter & "..."
End If
Cells(iCounter, 1).Select
Next iCounter
Range("A1").Select
Application.StatusBar = False
dteEnde = Timer
MsgBox "Die Umsätze werden ermittelt. Bearbeitungszeit: " & Format _
(dteEnde - dteStart, "0.00") & " Sekunden..."
Dim Wiederholungen As Long
For Wiederholungen = 14 To 87
Rows(Wiederholungen).Hidden = Cells(Wiederholungen, 1).Value = "x"
Next
Sheets("Hdl_Direktvergleich").Range("K14:N87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("P14:Q87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("S14:S87").Value = Clear
End Sub

Anzeige
AW: Makro beschleunigen
14.06.2020 21:35:51
onur
Und nach der MsgBox mit der Zeit vergehen nochmal 32-34 s ?
AW: Makro beschleunigen
14.06.2020 21:43:10
ralf_b
ganz ohne schleife wenn der bereich immer der gleiche ist
Range("A14:A87").EntireRow.hidden = True
Range("A14:A87") = "x"
warum markierst du denn in deinem Makro 5000 Zeilen in der Schleife? macht echt keinen Sinn wenn da nur die Statusbar gefüllt wird. ich glaub nicht das das der ganze Code ist.
AW: Makro beschleunigen
14.06.2020 21:45:21
onur
wieso schreibst du MIR das?
Abgesehen davon hast du den Code nicht richtig gelesen, NUR ausblenden, wenn "x".
hast recht, das ist mir durchgerutscht
14.06.2020 21:54:55
ralf_b
AW: Makro beschleunigen
14.06.2020 21:39:05
onur
Was soll DIESER Müll denn bringen?
For iCounter = 1 To 5000
If iCounter Mod 1000 = 0 Then
Application.StatusBar ="Besuche Zeile " & iCounter & "..."
End If
Cells(iCounter, 1).Select
Next iCounter

Anzeige
AW: Makro beschleunigen
14.06.2020 21:31:50
onur
Bau doch mal wie ich eine Stopp-Uhr ein.
Sub Berechnen()
Dim Wiederholungen As Long
Dim ti
ti = timer
For Wiederholungen = 14 To 87
Rows(Wiederholungen).Hidden = Cells(Wiederholungen, 1).Value = "x"
Next
MsgBox timer - ti
End Sub

AW: Makro beschleunigen
14.06.2020 21:45:32
Marko
Ich habe Dein Makro eingegeben. 17,32813 Sek.
Sehr gut. Es wirkt in jedem Fall dynamischer.
Vielen Dank.
AW: Makro beschleunigen
14.06.2020 21:47:09
onur
Wie (und WO) genau denn?
Poste mal.
AW: Makro beschleunigen
14.06.2020 21:50:27
Marko
Jetzt muss ich "blöd" fragen. Was meinst Du genau?
AW: Makro beschleunigen
14.06.2020 21:51:49
onur
Poste mal den jetzigen Code (mit den 17 s) KOMPLETT.
Recherche: GetMoreSpeed owt.
14.06.2020 21:58:01
Rudi
AW: Recherche: GetMoreSpeed owt.
14.06.2020 22:00:03
onur
DIESES Makro hat sowieso nicht viel mit dem WIRKLICHEN Makro zu tun, das er viel später erst gepostet hat.
Anzeige
AW: Recherche: GetMoreSpeed owt.
14.06.2020 22:11:29
Marko
Ich hoffe,das ist das was DU meintest...
Sub TextBox1_Change()
Worksheets("Tabelle7").Range("E1").Value = TextBox1 & Zahl
End Sub Sub Abfrage()
Dim Wiederholungen As Long
For Wiederholungen = 14 To 87
Rows(Wiederholungen).Hidden = Cells(Wiederholungen, 1).Value = "x"
Next
Sheets("Hdl_Direktvergleich").Range("K14:N87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("P14:Q87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("S14:S87").Value = Clear
End Sub
Private Sub TextBox1_Font()
Const TEXTBOX_HEIGHT = 30 'anpassen !!!
Const TEXTBOX_WIDTH = 75 'anpassen !!!
Application.ScreenUpdating = False
With TextBox1
If .TextLength > 0 Then
.AutoSize = True
If .Height > TEXTBOX_HEIGHT Then
Do While .Height > TEXTBOX_HEIGHT
.Font.Size = .Font.Size - 0.1
.Width = TEXTBOX_WIDTH
Loop
Else
Do While .Height  TEXTBOX_HEIGHT Then _
.Font.Size = .Font.Size - 0.1
End If
.AutoSize = False
.Width = TEXTBOX_WIDTH
.Height = TEXTBOX_HEIGHT
Else
.Width = TEXTBOX_WIDTH
.Height = TEXTBOX_HEIGHT
.Font.Size = 10
End If
End With
Application.ScreenUpdating = True
End Sub
Sub Cancel()
MsgBox "Die Daten werden gelöscht."
TextBox1.Text = ""
Sheets("Hdl_Direktvergleich").Rows("14:87").Hidden = True
Sheets("Hdl_Direktvergleich").Range("K14:N87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("P14:Q87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("S14:S87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("k10").Value = "Vergleich wählen"
Sheets("Hdl_Direktvergleich").Columns(13).Hidden = True
Sheets("Hdl_Direktvergleich").Columns(19).Hidden = True
End Sub Sub aktuellesBlattdrucken()
ActiveSheet.PageSetup.PrintArea = "$A$1:$R$90" 'Druckbereich festlegen
ActiveSheet.PrintOut 'Drucken
ActiveSheet.PageSetup.PrintArea = "" 'Druckbereich wieder entfernen
End Sub Sub Berechnen()
MsgBox "Die Umsätze werden ermittelt."
Dim Wiederholungen As Long
'Dim ti
'ti = Timer
For Wiederholungen = 14 To 87
Rows(Wiederholungen).Hidden = Cells(Wiederholungen, 1).Value = "x"
Next
'MsgBox Timer - ti
Sheets("Hdl_Direktvergleich").Range("K14:N87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("P14:Q87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("S14:S87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("B2").Select
End Sub
Anzeige
AW: Recherche: GetMoreSpeed owt.
14.06.2020 22:18:05
onur
Du hast immer noch nicht verraten, was das hier soll:
Sheets("Hdl_Direktvergleich").Range("K14:N87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("P14:Q87").Value = Clear
Sheets("Hdl_Direktvergleich").Range("S14:S87").Value = Clear

WAS soll "Clear" sein?
Wie hast du die 17 sec gemessen? Mit "meinem" Timer?
AW: Recherche: GetMoreSpeed owt.
14.06.2020 22:19:25
Marko
Das habe ich in ein Modul geschrieben und die entsprechenden Makros zugewiesen.
AW: Recherche: GetMoreSpeed owt.
14.06.2020 22:22:28
onur
Könntest du vielleicht endlich mal die Antwort in dem Threadzweig plazieren, in dem die Frage gestellt wurde?
Blickt doch keine Sau mehr durch, WEM bzw WELCHER FRAGE du gerade antwortest!
HIER z.B. hast du gerade DIR SELBER geantwortet!
Anzeige
AW: Makro beschleunigen
14.06.2020 22:29:43
GerdL
Moin,
noch ein schleifenloses Spielzeug.
Sub Nur_Zeilen_mit_x_anzeigen()
Dim R As Range, N As Range, lngCt As Long
Application.ScreenUpdating = False
'ausreichende Größe des benutzten Bereichs sicherstellen
Cells(Rows.Count, 1) = 0
Cells(Rows.Count, 1).ClearContents
Set R = Range(Cells(14, 1), Cells(87, 1))
lngCt = WorksheetFunction.CountIf(R, "x")
R.EntireRow.Hidden = lngCt = 0
If lngCt > 0 And lngCt 

Gruß Gerd
AW: Makro beschleunigen
14.06.2020 22:34:40
Marko
Vielen Dank.
AW: Makro beschleunigen mit Autofilter
15.06.2020 10:14:20
Daniel
HI
warum nicht mit dem Autofilter?
falls der DropDown nicht sichtbar sein soll, denn kann man auch ausblenden, so das es aussieht als wären die Zeilen normal ausgeblendet worden:
dann reicht dieser einzeiler
Range("A13:A87").AutoFilter field:=1, Criteria1:="x", visibledropdown:=False
zu deiner Frage, warum dein ursprünglicher Code so lange dauert und warum manche Antworter das anders erleben:
jede Aktion, die du auf einem Excelblatt ausführst, löst eine Reihe von Hintergrundaktionen aus.
Formeln werden neu berechnet, der Bildschirm wird aktualisiert, es wird geprüft, ob Eventmakros vorliegen und ob diese ausgeführt werden müssen.
wenn du jetzt die Zeilen einzeln per Schleife ein- und ausblendest, werden diese Aktionen für jedes einzelne Ein- und Ausblenden erneut ausgeführt, also sehr oft.
Wie lange das braucht, hängt aber auch davon ab, ob überhaupt und wenn wieviele betroffene Formeln vorliegen und wie lange deren Berechnung benötigt
Wenn du hingegen die Zeilen gemeinsam als Block in einem Schritt ein- oder ausblendest (so wie im Beispiel von GerdL, oder hier), so können diese Aktionen für alle Zeilen einmalig gemeinsam ausgeführt werden.
Gruß Daniel
Anzeige
AW: Makro beschleunigen mit Autofilter
15.06.2020 23:24:02
Marko
Hallo Daniel,
vielen Dank für die ausführliche Erklärung.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige