Display Status Bar

Bild

Betrifft: Display Status Bar
von: Norbert
Geschrieben am: 26.04.2005 10:23:57
Hallo an Alle,
bin mit einem Code am arbeiten, der mir doppelte Einträge farbig markiert und der auch funktioniert. Da ich und andere Kollegen sehr lange Softwarelisten zu bearbeiten haben, entschloss ich mich einen Status mit anzeigen zu lassen.
(Excel tut eine Weile nichts, man könnte meinen das Excel hängt)
Dazu fand ich ein Script auf Herbers Server, habe auch schon einiges versucht, komme aber nicht richtig vorwärts. Es sollte also in der Statusbar angezeigt werden, wie weit Excel den Prozess (doppelte Einträge suchen)abgearbeitet hat,
damit auch erkannt wird, dass Excel noch was tut.
Hier mal das Script doppelte Einträge suchen und das was ich zum Thema Statusbar fand. Wichtig ist auch, es können keine zusätzlichen Verweise oder Laufzeitumgebungen eingebunden werden!
Sub finden()
Dim iRow As Integer, iRowL As Integer, iCounter As Integer
iRowL = Cells(Cells.Rows.Count, 2).End(xlUp).Row
For iRow = iRowL To 1 Step -1
If WorksheetFunction.CountIf(Columns(1), Cells(iRow, 1)) > 1 Then
Rows(iRow).Columns(1).Interior.ColorIndex = 33
End If
Next iRow
Code vom Excelsever:
'In Klassenmodul einfügen


Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayStatusBar = bln
End Sub


Private Sub Workbook_Open()
    bln = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
End Sub

'In Modul einfügen
Public bln As Boolean
Sub Fortschritt()
Dim iCounter As Integer
Application.DisplayStatusBar = True
For iCounter = 1 To 10
StatusLED "schon geschafft: ", iCounter / 10
Application.Wait Now + TimeSerial(0, 0, 1)
Next iCounter
Application.StatusBar = False
End Sub

Private Function StatusLED(sMsg As String, sPct As Single)
    Dim iPct As Integer, iReps As Integer
    With WorksheetFunction
        iPct = .Round(sPct, 2) * 100
        iReps = Int(iPct / 10)
        Application.StatusBar = sMsg & .Rept(Chr(14), iReps) & .Rept("*", 10 - iReps) & " " & iPct & "%"
    End With
End Function

Kann man dies so hinbekommen, dass anstelle eines Count's, der Fortschritt des "Finden" - Macros angezeigt wird?
Vielen Dank vorab, für Eure Bemühungen!
Gruß Norbert.
Bild

Betrifft: AW: Display Status Bar
von: ANdreas
Geschrieben am: 26.04.2005 10:36:45
Hallo Norbert,
löse es besser über die bedingte Formatierung, schneller dürfte es kaum gehen:

Sub DoppelteMarkieren()
Range("A1").Select
With Columns(1)
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=ZÄHLENWENN($A:$A;A1)>1"
    .FormatConditions(1).Interior.ColorIndex = 33
End With
End Sub


Sub MarkierungAufheben()
Columns(1).FormatConditions.Delete
End Sub

Hoffe das hilft weiter,
Andreas
Bild

Betrifft: AW: Display Status Bar
von: Norbert
Geschrieben am: 26.04.2005 11:56:02
Hallo Andreas,
danke für Deine promte Hilfe, habe es schon ausprobiert, ist ja wirklich schnell.
Könnte man diese doppelten Einträge in einem nächsten Step auch löschen?
Noch eine Idee hätte ich, wenn es z.B. in Spalte "B" eine Anzahl gäbe, mit der die doppelten Einträge addiert werden. (Der erste doppelt vorkommende Eintrag soll die Anzahl seiner Doppelgänger hinzu bekommen.)Also nicht nur "1+1" sondern es könnte ja
auch "13+2" sein. Kleines Beispiel:
Spalte A Spalte B
Software Anzahl
Adobe 13
Adobe 2
Adobe 3
Daraus soll werden "Adobe 18" usw. Die übrigen könnten gelöscht werden.
Funktioniert so etwas.
Experimentell interessiert es mich trotzdem, wie bei meiner ersten Frage, eine StatusLED funktionieren würde, bis ein Prozess abgelaufen ist. (Nicht nur einen Count runter zählen)
Danke erstmal, ich freue mich über jeden Vorschlag.
Gruß Norbert!
Bild

Betrifft: AW: Display Status Bar
von: Norbert
Geschrieben am: 26.04.2005 12:26:05
Hallo,
danke für Deine promte Hilfe, habe es schon ausprobiert, ist ja wirklich schnell.
Könnte man diese doppelten Einträge in einem nächsten Step auch löschen?
Noch eine Idee hätte ich, wenn es z.B. in Spalte "B" eine Anzahl gäbe, mit der die doppelten Einträge addiert werden. (Der erste doppelt vorkommende Eintrag soll die Anzahl seiner Doppelgänger hinzu bekommen.)Also nicht nur "1+1" sondern es könnte ja
auch "13+2" sein. Kleines Beispiel:
Spalte A Spalte B
Software Anzahl
Adobe 13
Adobe 2
Adobe 3
Daraus soll werden "Adobe 18" usw. Die übrigen könnten gelöscht werden.
Funktioniert so etwas.
Experimentell interessiert es mich trotzdem, wie bei meiner ersten Frage, eine StatusLED funktionieren würde, bis ein Prozess abgelaufen ist. (Nicht nur einen Count runter zählen)
Danke erstmal, ich freue mich über jeden Vorschlag.
Gruß Norbert!
Bild

Betrifft: AW: Display Status Bar
von: ANdreas
Geschrieben am: 26.04.2005 14:08:48
Hallo Norbert,
anbei ein neuer Ansatz für Deine Frage:

Private Function StatusLED(sMsg As String, sPct As Single)
    Dim iPct As Integer, iReps As Integer
    With WorksheetFunction
        iPct = .Round(sPct, 2) * 100
        iReps = Int(iPct / 10)
        Application.StatusBar = sMsg & .Rept(Chr(14), iReps) & .Rept("*", 10 - iReps) & " " & iPct & "%"
    End With
End Function

Public Sub DoppelteLoeschen()
Dim i&, lngLast&
On Error Resume Next
Application.ScreenUpdating = False

lngLast = Cells(Rows.Count, 2).End(xlUp).Row
' Erst aufsummieren
For i = 1 To lngLast
If WorksheetFunction.CountIf(Range(Cells(i, 1), _
Cells(lngLast, 1)), Cells(i, 1)) > 1 Then
With Cells(i, 1)
.Offset(0, 1).Value = _
WorksheetFunction.SumIf(Columns(1), .Value, Columns(2))
End With
End If
StatusLED "Aufsummieren: ", i / lngLast
Next i

' DoppelteLoeschen
For i = lngLast To 1 Step -1
With Cells(i, 1)
If WorksheetFunction.CountIf(Columns(1), .Value) > 1 Then _
.EntireRow.Delete
End With
StatusLED "Doppelte Löschen: ", (lngLast - i) / lngLast
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Gruß
Andreas
Bild

Betrifft: AW: Display Status Bar
von: Norbert
Geschrieben am: 26.04.2005 15:20:16
Hallo Andreas,
danke, dass sieht auf den ersten Blick sehr gut aus. Werde es noch testen.
Melde mich wieder über das Forum wie's gelaufen ist.
Danke nochmal.
Gruß Norbert.
PS: Wenn ich die selektierten Einträge nicht löschen mochte, sondern nur in ein anderes
Sheet verschieben, geht das auch. (".EntireRow.Delete" - dies als verschieben)
Bild

Betrifft: AW: Display Status Bar
von: ANdreas
Geschrieben am: 26.04.2005 15:34:17
Hallo Norbert,
wäre schön, wenn Du Dich mal entscheiden könntest ;-)
Bei der Lösung werden mehrfache Vorkommen in das Sheet "Ziel" kopiert (also nicht das erste Vorkommen), dann wird wie bisher aufsummiert und die kopierten werden rausgelöscht.
Sub DoppelteLoeschen()
Dim i&, lngLast&, j&
On Error Resume Next
Application.ScreenUpdating = False
lngLast = Cells(Rows.Count, 2).End(xlUp).Row
' Mehrfache Vorkommen kopieren in anderes Sheet
Worksheets("Ziel").ClearContents
j = 1
For i = 1 To lngLast
With Cells(i, 1)
If WorksheetFunction.CountIf(Range(Cells(1, 1), _
Cells(i, 1)), .Value) > 1 Then
.EntireRow.Copy Destination:=Worksheets("Ziel").Cells(j, 1)
j = j + 1
End If
End With
Next i
' Aufsummieren
For i = 1 To lngLast
If WorksheetFunction.CountIf(Range(Cells(i, 1), _
Cells(lngLast, 1)), Cells(i, 1)) > 1 Then
With Cells(i, 1)
.Offset(0, 1).Value = _
WorksheetFunction.SumIf(Columns(1), .Value, Columns(2))
End With
End If
StatusLED "Aufsummieren: ", i / lngLast
Next i

' DoppelteLoeschen
For i = lngLast To 1 Step -1
With Cells(i, 1)
If WorksheetFunction.CountIf(Columns(1), .Value) > 1 Then _
.EntireRow.Delete
End With
StatusLED "Doppelte Löschen: ", (lngLast - i) / lngLast
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
On Error GoTo 0
End Sub

Private Function StatusLED(sMsg As String, sPct As Single)
    Dim iPct As Integer, iReps As Integer
    With WorksheetFunction
        iPct = .Round(sPct, 2) * 100
        iReps = Int(iPct / 10)
        Application.StatusBar = sMsg & .Rept(Chr(14), iReps) & .Rept("*", 10 - iReps) & " " & iPct & "%"
    End With
End Function

Gruß
Andreas
Bild

Betrifft: AW: Display Status Bar
von: Norbert
Geschrieben am: 26.04.2005 16:20:39
Hallo Andreas,
danke, Du bist ja schneller als die Polizei erlaubt :-). Jo, hab mich schon entschieden,
bin auch immer so am probieren. Im Step "doppelte loeschen" fehlte ein "End If" aber sonst lief es super, auch mit kopieren. Aber, Aber... Die Statusanzeige geht nicht.
Wo könnte man da noch schrauben!?
Gruß Norbert
Bild

Betrifft: AW: Display Status Bar
von: ANdreas
Geschrieben am: 26.04.2005 16:28:45
Hallo Norbert,
im Step DoppelteLoeschen fehlt kein End IF wenn Du es richtig kopiert hast. Der dortigen IF-Bedingung folgt nur eine Bedingung (Zeilenumbruch mit _)
Warum die Statusanzeige nicht funktioniert, kann ich leider nicht nachvollziehen. Bei mir funktioniert es einwandfrei.
Vielleicht setzt Du einfach mal einen Haltepunkt in der Funktion und gehst es schrittweise durch.
Statusleiste ist aber eingeblendet? (Menü Ansicht)
Gruß
Andreas
Bild

Betrifft: AW: Display Status Bar
von: Norbert
Geschrieben am: 26.04.2005 16:52:16
Hallo Andreas,
ich danke Dir nochmals, Du hast mir sehr geholfen. Werde das nochmal checken mit der
Statusleiste.
Schönen Feierabend, Gruß Norbert.
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Display Status Bar"