Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
816to820
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
816to820
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Fortschriitsbalken

Fortschriitsbalken
12.11.2006 00:07:03
Universal
Guten Abend VBA`ler,
ich weiß, zum zigsten Mal wird diese Frage nun wieder gestellt. Habe einen Makro, der das amerikanische und deutsche Datumsformat ausliest. Diese Prozedur kann mit unter länger dauern. Also dachte ich mir: "Mensch, entwickelst du einfach mal nen Fortschrittsbalken". Habe mich dahingehend hier im Forum schon umgesehen, komme nun aber doch nicht weiter.
Ich arbeite mit der Microsoft ProgressBar, die ich in die UserForm "usfFortschritt" eingebaut habe. Name der ProgressBar = Fortschritt
mein bisheriger Code:

Sub Fortschritt()
Anzahl = Application.CountA(ActiveSheet.Range("A2:A65536").Cells)
For progress = 1 To Anzahl
usfFortschritt.Show
usfFortschritt.Fortschritt.Value = 1 + (100 / Anzahl)
Dim lZeile   As Long
Dim iZahl_D  As Integer
Dim iZahl_A  As Integer
For lZeile = 2 To Range("A65536").End(xlUp).Row
If Range("A" & lZeile).NumberFormat = "m/d/yyyy h:mm" Then
iZahl_A = iZahl_A + 1
Else
iZahl_D = iZahl_D + 1
End If
Next lZeile
DoEvents
Next progress
MsgBox "Anzahl deutscher Werte: " & iZahl_D & Chr(10) & _
"Anzahl amerikanischer Werte: " & iZahl_A
End Sub

Mit dem DoEvents bin ich mir nicht sicher. Hatte es irgendwo mal gelesen, weiß nun aber nicht, ob es da richtig steht. Wenn ich diesen Code nun Ausführe, aktualisiert sich der Balken nicht von allein. Ich muss ständig auf das "x" klicken. Nach einigen Klicks bekomme ich die Fehlermeldung: "Laufzeitfehler 6, Überlauf"
Was habe ich falsch gemacht? Kann mir jemand helfen? Vielen vielen Dank!
Gruß
Uni

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fortschriitsbalken
12.11.2006 00:15:52
K.Rola
Hallo,
Ohne die Sinnhaftigkeit des Codes durchleuchtet zu haben, sträubt sich beim Anblick dieser Zeile:
usfFortschritt.Show innerhalb der Schleife mein Hirn.
Platzier das außerhalb der Schleife.
Gruß K.Rola
AW: Fortschriitsbalken
12.11.2006 00:17:55
ramses
Hallo
Wie auch K.Rola bereits sagte hier mal als modifiziertes Beispiel.
Option Explicit

Private Sub Fortschritt()
Dim Anzahl As Long, Progress As Long
Dim lZeile   As Long
Dim iZahl_D  As Long
Dim iZahl_A  As Long
Anzahl = Application.CountA(ActiveSheet.Range("A2:A65536").Cells)
usfFortschritt.Show
For Progress = 1 To Anzahl
usfFortschritt.Fortschritt.Value = 1 + (100 / Anzahl)
For lZeile = 2 To Range("A65536").End(xlUp).Row
If Range("A" & lZeile).NumberFormat = "m/d/yyyy h:mm" Then
iZahl_A = iZahl_A + 1
Else
iZahl_D = iZahl_D + 1
End If
Next lZeile
DoEvents
Next Progress
MsgBox "Anzahl deutscher Werte: " & iZahl_D & Chr(10) & _
"Anzahl amerikanischer Werte: " & iZahl_A
End Sub

Gruss Rainer
Anzeige
AW: Fortschriitsbalken
12.11.2006 10:18:54
Universal
Danke Rainer und guten Morgen!
Ja okay, dass mit der Userform innerhalb einer For ... Next - Schleife hätte ich auch sehen können. @K.Rola habe doch aber angegeben VBA = nein.
Leider funzt dieser Fortschrittsbalken nicht. Die Userform startet und nix passiert. Wenn ich sie dann schließe, beginnt er die "For lZeile Schleife" abzuarbeiten und gibt dann die MsgBox aus. Ich habe versucht den Fortschrittsbalken mal ohne meinen "Datumsauslese-Code" laufen zu lassen - es kommt leider das selbe Ergebnis raus.
Code:

Private Sub Fortschritt()
Dim Anzahl As Long, Progress As Long
Anzahl = Application.CountA(ActiveSheet.Range("A2:A65536").Cells)
usfFortschritt.Show
For Progress = 1 To Anzahl
usfFortschritt.Fortschritt.Value = 1 + (100 / Anzahl)
DoEvents
Next Progress
End Sub

Was habe ich / wir falsch gemacht?
Gruß
Uni
Anzeige
AW: Fortschriitsbalken
12.11.2006 10:38:41
Oberschlumpf
Hi Uni?! &lt-- wie war das mit dem Vornamen?
Sobald ein UF aufgerufen wird, wird (normalerweise) nur der VBA-Code durchgeführt, der sich in den Ereignissen des UFs befindet.
Das bedeutet, dass du den For-Next-Code in eines der Ereignisse des UFs verschieben musst - hier bietet sich das Activate-Ereignis an.
Hinweis zu "normalerweise":
VBA-Code außerhalb eines UFs wird - glaube ich - auch ausgeführt, wenn du das UF ungebunden aufrufst (aber das weiß ich nicht genau):
Userform1.Show 0
Wird ein UF ungebunden aufgerufen, kannst du auch trotz der UF-Anzeige in der Tabelle beliebige Zellen anklicken, die Werte ändern usw.
Wird ein UF gebunden aufgerufen, kannst du die Tabelle erst wieder bearbeiten, nachdem das UF geschlossen ist.
Konnte ich helfen?
Ciao
Thorsten
Anzeige
AW: Fortschriitsbalken
12.11.2006 10:42:01
ramses
Hallo
"..@K.Rola habe doch aber angegeben VBA = nein..."
Sorry, aber wer Fortschrittsbalken und Schleifen so programmiert, kann dies nicht als Entschuldigung bringen :-)
Hier wird der Fehler sein:
usfFortschritt.Fortschritt.Value = 1 + (100 / Anzahl)
Anzahl ist fix vorgegeben als EndWert und wird während des Schleifendurchgangs nicht mehr verändert. Ausserdem ist kein Wert gegeben, daher ändert sich auch das Ergebnis während der Schleife nicht mehr
'Festlegen des MIN-Wertes und des MAX-Wertes
With usfFortschritt
.Show
.Fortschritt.Min = 1
.Fortschritt.Max = Anzahl
End With
For Progress = 1 To Anzahl
'Zuweisen das ValueWertes aus "Progress"
usfFortschritt.Fortschritt.Value = progress
Damit solltest hast du einen direkten Verlauf im Verhältnis zur Codelänge haben
Gruss Rainer
Anzeige
AW: Fortschriitsbalken
12.11.2006 15:15:33
Universal
Ich gebs auf. :) Nun funktioniert der Balken, jedoch hört er beim MAX-Wert nicht auf, sondern läuft und läuft und läuft. Am Ende hat man ein ganz anderes Ergebnis, als wenn ich den Datumsauslese-Code starte. Aus diesem Grund und zum besseren Verständnis habe ich die Datei gezippt und hochgeladen. Link: https://www.herber.de/bbs/user/38099.zip
Ihr findet in dem Dokument zwei Makros. 1. Fortschrittsbalken und 2. Zählen. Im Zählen-Makro erfolgt die Ausgabe über eine MsgBox ohne Fortschrittsbalken. Das andere Makro gibt das Ergebnis in Zelle D8839 und E8839 aus. Wundert euch bitte nicht über die Geschwindigkeit (sehr schnell) beim Zählen-Makro. Die hochgeladene Datei enthält nur einen Auszug aus der original Datei!
Zusammenfassend kann man sagen, dass der Fortschrittsbalken angezeigt und aktualisiert wird, jedoch der "MAX-Wert" nicht stimmt - würde ich sagen.
Ich danke euch vielmals!!!!!!
Uni
Anzeige
AW: Fortschriitsbalken
12.11.2006 15:49:55
Stefan
Hallo Uni,
Die Loesung mit dem Fortschritssbalken geht auch ein bisschen schneller - um genauer zu sein fast 8836 mal schneller. Warum brauchst Du zwei Schleifen die das selbe bewirken, mit jeweils 8836 Durchgaengen, ineinander? Deine "Progress" und lZeile-Schleifen sind praktisch identisch und sollten zusammengefasst werden.
Aus diesem Grund bekommst Du auch Ergebniswerte die 8836 mal groesser sind als sie sollten: Du laesst jede Zelle 8836 mal nach ihrem Format abfragen.
Versuch mal diesen Code:

Private Sub UserForm_Activate()
Dim Anzahl As Long, Progress As Long
Dim lZeile   As Long
Dim iZahl_D  As Long
Dim iZahl_A  As Long
Anzahl = Application.CountA(ActiveSheet.Range("A2:A65536").Cells)
With pbarFortschritt
.Min = 1
.Max = Anzahl
End With
For Progress = 1 To Anzahl
lblDaten.Caption = "Daten werden analysiert ... " & Progress & " von " & Anzahl
pbarFortschritt.Value = Progress
lZeile = Progress + 1
If Range("A" & lZeile).NumberFormat = "m/d/yyyy h:mm" Then
iZahl_A = iZahl_A + 1
Else
iZahl_D = iZahl_D + 1
End If
DoEvents
Next Progress
Me.Hide
ActiveSheet.Range("d8839").Value = iZahl_D & "deutsches Datum"
ActiveSheet.Range("e8839").Value = iZahl_A & "amerikanisches Datum"
'MsgBox "Anzahl deutscher Werte: " & iZahl_D & Chr(10) & _
"Anzahl amerikanischer Werte: " & iZahl_A
End Sub

Schoene Gruesse
Stefan
Anzeige
AW: Fortschriitsbalken
13.11.2006 18:27:11
Universal
Sehr schön! Danke - es funktioniert auch so. :)
AW: Fortschriitsbalken
12.11.2006 13:04:14
Peter
Hallo Uni,
so wird bei mir der Fortschritt angezeigt:
Public 

Sub Fortschritt()
Dim Anzahl     As Long
Dim Vergleich  As Long
Dim lZeile     As Long
Dim iZahl_D    As Long
Dim iZahl_A    As Long
Anzahl = Application.CountA(ActiveSheet.Range("A2:A65536").Cells)
Vergleich = CInt(Anzahl / 100)
usfFortschritt.Show
For lZeile = 2 To Range("A65536").End(xlUp).Row
If Range("A" & lZeile).NumberFormat = "m/d/yyyy h:mm" Then
iZahl_A = iZahl_A + 1
Else
iZahl_D = iZahl_D + 1
End If
If lZeile = Vergleich Then
usfFortschritt.Fortschritt.Value = usfFortschritt.Fortschritt.Value + 1
Vergleich = Vergleich + Anzahl / 100
End If
DoEvents
Next lZeile
MsgBox "Anzahl deutscher Werte: " & Chr(9) & Format(iZahl_D, "#,##0") & Chr(10) & _
"Anzahl amerikanischer Werte: " & Chr(9) & Format(iZahl_A, "#,##0"), _
64, "   Zählung der Formate."
Unload usfFortschritt
End Sub

Public 

Sub UserForm1_anzeigen()
Call Fortschritt
End Sub

Mein Fortschrittsbalken hat eine Width von 546.
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
Anzeige
AW: Fortschriitsbalken
12.11.2006 18:14:39
Universal
Hi Peter,
sehr schön. Dieser Fortschrittsbalken funktioniert - vielen Dank. Nun dachte ich, ich könne das auch für ein zweites Makro anwenden.
Code:

Private Sub UserForm_Activate()
Dim rngC As Range, t As Date
Dim tt As Integer, mm As Integer, jj As Integer, zeit As Double
Dim Anzahl     As Long
Dim Vergleich  As Long
Dim iZahl_D    As Long
Dim iZahl_A    As Long
Anzahl = Application.CountA(ActiveSheet.Range("A2:A65536").Cells)
Vergleich = CInt(Anzahl / 100)
Range("A:A").NumberFormat = "dd/mm/yyyy hh:mm"
For Each rngC In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
lblUmwandlung.Caption = "Datumsformat wird umgewandelt ... "
If Not IsNumeric(rngC.Value2) Then
rngC.Replace What:="/", Replacement:="."
t = rngC.Value
rngC = t
Else
t = rngC
mm = Day(t)
tt = Month(t)
jj = Year(t)
zeit = t - Int(t)
t = Str(tt) & "." & Str(mm) & "." & Str(jj)
t = t + CDate(zeit)
rngC = t
End If
If rngC = Vergleich Then
usfUmwandlungFort.pbarFortschritt.Value = usfUmwandlungFort.pbarFortschritt.Value + 1
Vergleich = Vergleich + Anzahl / 100
End If
DoEvents
Next
usfFahrplan.chknonJahresband.Value = False
If usfFahrplan.txtPasswort.Value <> usfFahrplan.txtPasswortW.Value Or usfFahrplan.txtPasswort.Value = "" Or usfFahrplan.txtPasswortW.Value = "" Then
usfFahrplan.txtPWcheck.Visible = False
usfFahrplan.txtPWcheck2.Visible = True
usfFahrplan.cmdSpeichern.Enabled = False
Else
usfFahrplan.txtPWcheck.Enabled = True
usfFahrplan.txtPWcheck.Visible = True
usfFahrplan.txtPWcheck2.Visible = False
usfFahrplan.cmdSpeichern.Enabled = True
End If
If usfFahrplan.optVtlwerte.Value = True Then usfFahrplan.txtTest.Value = Application.Sum(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)) / 4 & " MWh"
If usfFahrplan.optStdwerte.Value = True Then usfFahrplan.txtTest.Value = Application.Sum(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)) & " MWh"
Unload usfUmwandlungFort
End Sub

Hier ist das Problem, dass es keine Variable, wie vorhin "lZeile", gibt. Gibt es hier auch eine Möglichkeit den Fortschrittsbalken "laufen" zu lassen?
Gruß und danke!!!
Uni
Anzeige
AW: Fortschrittsbalken
12.11.2006 20:42:20
Peter
Hallo Uni,
so geht es:

Private Sub UserForm_Activate()
Dim rngC As Range, t As Date
Dim tt As Integer, mm As Integer, jj As Integer, zeit As Double
Dim Anzahl     As Long
Dim Vergleich  As Long
Dim iRngC      as Long
Dim iZahl_D    As Long
Dim iZahl_A    As Long
Anzahl = Application.CountA(ActiveSheet.Range("A2:A65536").Cells)
Vergleich = CInt(Anzahl / 100)
Range("A:A").NumberFormat = "dd/mm/yyyy hh:mm"
For Each rngC In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
iRngC = iRngC + 1
lblUmwandlung.Caption = "Datumsformat wird umgewandelt ... "
If Not IsNumeric(rngC.Value2) Then
rngC.Replace What:="/", Replacement:="."
t = rngC.Value
rngC = t
Else
t = rngC
mm = Day(t)
tt = Month(t)
jj = Year(t)
zeit = t - Int(t)
t = Str(tt) & "." & Str(mm) & "." & Str(jj)
t = t + CDate(zeit)
rngC = t
If iRngC = Vergleich Then
usfUmwandlungFort.pbarFortschritt.Value = usfUmwandlungFort.pbarFortschritt.Value + 1
Vergleich = Vergleich + Anzahl / 100
End If
DoEvents
end if
Next
usfFahrplan.chknonJahresband.Value = False
If usfFahrplan.txtPasswort.Value <> usfFahrplan.txtPasswortW.Value Or usfFahrplan.txtPasswort.Value = "" Or usfFahrplan.txtPasswortW.Value = "" Then
usfFahrplan.txtPWcheck.Visible = False
usfFahrplan.txtPWcheck2.Visible = True
usfFahrplan.cmdSpeichern.Enabled = False
Else
usfFahrplan.txtPWcheck.Enabled = True
usfFahrplan.txtPWcheck.Visible = True
usfFahrplan.txtPWcheck2.Visible = False
usfFahrplan.cmdSpeichern.Enabled = True
End If
If usfFahrplan.optVtlwerte.Value = True Then usfFahrplan.txtTest.Value = Application.Sum(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)) / 4 & " MWh"
If usfFahrplan.optStdwerte.Value = True Then usfFahrplan.txtTest.Value = Application.Sum(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)) & " MWh"
Unload usfUmwandlungFort
End Sub

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
Anzeige
AW: Fortschrittsbalken
13.11.2006 18:25:48
Universal
Hi Peter,
danke für die schnelle Antwort. Hatte mir so etwas schon gedacht - wusste aber nicht wie. :( Nun läuft der Balken, jedoch bei gedachten 25 % des Balkens, wird die UserForm geschlossen - er ist also schneller fertig, als der Balken anzeigt. Gibt es dafür eine Erklärung? Eigentlich wird bei jedem Durchlauf der "For-Schleife" der Balken aktualisiert, oder?
Einen schönen Abend noch
Gruß
Uni
AW: Fortschrittsbalken
13.11.2006 20:13:02
Universal
Danke Peter, habe mir eben mein "Programm" nochmal angeguckt. Ich muss gestern irgendetwas falsch gemacht haben. Es funktioniert alles so, wie ich es mir vorstelle!
Vielen vielen Dank an alle fleißigen Helfer!!!
Gruß
Uni

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige