Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1172to1176
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

Funktionen Progressbar

Funktionen Progressbar
RainerK
Hallo,
möchte vor dem Ausführen dieses Codes eine Text in die UserForm mit "Label3" einfügen.
Bei der Ausführung erscheint dieser aber erst kurz nach der hälfte der Zeit, welche für die Ausführung benötigt wird.

Dim wks As Worksheet
Dim i As Integer
Set wks = ThisWorkbook.Worksheets("Ansicht")
With wks
For i = 23 To 550
Me.Label3.Visible = True
Me.ProgressBar1.Visible = True
Me.ProgressBar1.Max = 550
Me.ProgressBar1.Min = 0
If .Cells(i, 4).Value = "x" Then
.Rows(i).Hidden = False
Me.ProgressBar1 = i
Application.Wait Now + TimeSerial(0, 0, 1)
Else
.Rows(i).Hidden = True
Me.ProgressBar1 = i
End If
Next i
End With
Habe gerade erst angefangen, die ProgressBar einzusetzen und hab da leider keinen Plan.
Gruß Rainer

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

Betreff
Benutzer
Anzeige
AW: Funktionen Progressbar
06.09.2010 12:37:02
EvilRik
Hallo Rainer,
versuch mal folgenden Code.
Wofür brauchst du denn für so einen kurzen Code eine ProgressBar? Ist doch schnell ausgeführt.
Ansonsten noch die Alternative über

Application.StatusBar= i
.
Beide Varianten verlangsamen den ausführenden Code aber.
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Me.Show (vbModeless)
Me.Label1.Visible = True
Application.Wait Now + TimeSerial(0, 0, 1)
Me.ProgressBar1.Visible = True
Me.ProgressBar1.Max = 550
Me.ProgressBar1.Min = 0
Set wks = ThisWorkbook.Worksheets("Ansicht")
With wks
For i = 23 To 550
If .Cells(i, 4).Value = "x" Then
.Rows(i).Hidden = False
Me.ProgressBar1 = i
Application.Wait Now + TimeSerial(0, 0, 1)
Else
Worksheets(1).Rows(i).Hidden = True
Me.ProgressBar1 = i
End If
Next i
End With
Me.Hide
Application.ScreenUpdating = True
End Sub

Gruß Henrik
Anzeige
AW: Funktionen Progressbar
06.09.2010 14:14:13
EvilRik
Hallo Rainer,
versuch mal folgenden Code.
Wofür brauchst du denn für so einen kurzen Code eine ProgressBar? Ist doch schnell ausgeführt.
Ansonsten noch die Alternative über

Application.StatusBar= i
.
Beide Varianten verlangsamen den ausführenden Code aber.
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Me.Show (vbModeless)
Me.Label1.Visible = True
Application.Wait Now + TimeSerial(0, 0, 1)
Me.ProgressBar1.Visible = True
Me.ProgressBar1.Max = 550
Me.ProgressBar1.Min = 0
Set wks = ThisWorkbook.Worksheets("Ansicht")
With wks
For i = 23 To 550
If .Cells(i, 4).Value = "x" Then
.Rows(i).Hidden = False
Me.ProgressBar1 = i
Application.Wait Now + TimeSerial(0, 0, 1)
Else
Worksheets(1).Rows(i).Hidden = True
Me.ProgressBar1 = i
End If
Next i
End With
Me.Hide
Application.ScreenUpdating = True
End Sub

Gruß Henrik
Anzeige
AW: Funktionen Progressbar
06.09.2010 15:39:08
RainerK
Hallo Henrik,
vielen Dank für Deine Mithilfe.
Die Aktivierung des Label's hatte ich auch schon vor die eigentliche Ausführung des Codes gestellt und war auch erst nach der Hälfte der Ausführung erschienen.
Allerdings aktiviere ich nicht innerhalb _Initialize.
Der Code wird durch einen OptionButton aktiviert.
Zur Dauer; habe ich mich auch gewundert, aber es braucht schon etwas Zeit, weshalb ich mich dann eben auch entschieden habe die ProgressBar einzusetzen.
Gruß Rainer
zur Dauer
06.09.2010 15:58:00
Rudi
Hallo,
kein Wunder, wenn du den Code immer 1 Sek warten lässt.
Und versuch mal
Label13.visible=true
Repaint
Gruß
Rudi
Anzeige
AW: zur Dauer
06.09.2010 16:22:49
RainerK
Hallo Rudi,
ne, ne, man darf sich schon wundern.
Der Code war ja vorher so:
                Dim wks As Worksheet
Dim i As Integer
Set wks = ThisWorkbook.Worksheets("Ansicht")
With wks
For i = 23 To 550
If .Cells(i, 4).Value = "x" Then
.Rows(i).Hidden = False
Else
.Rows(i).Hidden = True
End If
Next i
End With

Und da dieser so lange brauchte habe ich die ProgressBar eingesetzt.
Aber Repaint teste ich gleich mal.
Gruß Rainer
AW: zur Dauer
06.09.2010 17:00:06
Rudi
Hallo,
dürfte erhelich schneller sein:
Sub ttt()
Dim wks As Worksheet
Dim i As Integer
Dim rngHidden As Range
Set wks = ThisWorkbook.Worksheets("Ansicht")
With wks
For i = 23 To 550
If .Cells(i, 4).Value  "x" Then
If rngHidden Is Nothing Then
Set rngHidden = .Cells(i, 4)
Else
Set rngHidden = Union(rngHidden, .Cells(i, 4))
End If
End If
Next i
.Range(.Rows(23), .Rows(550)).Hidden = False
If Not rngHidden Is Nothing Then rngHidden.EntireRow.Hidden = True
End With
End Sub

Gruß
Rudi
Anzeige
AW: zur Dauer
06.09.2010 20:11:41
RainerK
Hallo Rudi,
den Code muss ich mir merken.
Ist ja um einiges schneller und wirklich so, dass die ProgressBar nicht benötigt wird.
Gruß und vielen Dank
Rainer
AW: zur Dauer
11.09.2010 14:38:25
RainerK
Hallo,
wollte den mir von Rudi erstellten Code ergänzen und hänge gerade total.
For i = 23 To 550
If .Cells(i, 4).Value  "x" Then
If rngHidden Is Nothing Then
Set rngHidden = .Cells(i, 4)
Else
Set rngHidden = Union(rngHidden, .Cells(i, 4))
End If
End If
Next i
.Range(.Rows(23), .Rows(550)).Hidden = False
If Not rngHidden Is Nothing Then rngHidden.EntireRow.Hidden = True
For i = 23 To 550
If .Cells(i, 2).Value = Tabelle10.Cells(10, 8) Then
If Tabelle10.Cells(10, 8) 

Ziel im zweiten Durchlauf sollte eine Seitenanpassung sein.
Wenn in Spalte B der Wert von H10 steht, soll soll eine geprüft werden, ob dieser 12,13,14 oder 15 beträgt und wenn ja, die 3. Zeile davor in der Höhe entsprechend verändert werden.
(Möchte in diesem Fall ab i-2 auf nächste Seite bringen.
Vielleicht gibts ja auch ein elegante Lösung mit Zeilenumbruch.
Mit Else ... möchte ich die Rückstellung bewirken.
Gruß Rainer
Anzeige
AW: zur Dauer
11.09.2010 16:54:58
RainerK
Hallo,
habe Problem gelöst bekommen. Hatte in meinen Versuchen einen Gedankenfehler.
Werde nun den Seitenumbruch nehmen.
Mein Ergebnis incl. Test's:
      For i = 23 To 550
'MsgBox i & " " & Tabelle10.Cells(10, 8) & " " & .Cells(i, 2).Value
If Tabelle10.Cells(10, 8) 
Just zur Info. Vielleicht habe ich ja wieder einen Fehler, der mir bzw. dem Code viel Zeitabverlangt.
Gruß Rainer

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige