Office: (Office 2010) Hilfe zu Fortschrittsanzeige

Guten Morgen,

ich benötige einmal etwas Hilfe.
Ich habe einige Exceldateien, welche Daten abgleichen und Fehlerhafte Werte in ein temporäres Blatt schreiben.
Diese Auswertung kann u.U. sehr lange dauern, in dieser Zeit sieht es so aus, als ob Excel steht.
Mein Code ( nur der Auszug der Fehler ) sieht wie folgt aus :

Code:

        
    If initialer_durchlauf = False Then
        Sheets("Daten_1").Select
        Dim last_d_1, c1, c2, lb1i As Integer
        last_d_1 = Cells(Rows.count, 2).End(xlUp).Row
        lb1i = ListBox1.ListCount - 1
        With Diff.ListBox2
            .ColumnCount = 2
            .ColumnWidths = "5cm;5cm"
        End With
        For c1 = 2 To last_d_1
            For c2 = 0 To lb1i
                If ListBox1.List(c2, 0) = Range("F" & c1).Value Then
                    Range("K" & c1).Interior.Color = &HC000&
                End If
            Next c2
        Next c1
        ReDim userarray(0)
        Dim array_user_count As Long
        Dim stringsave As String
        array_user_count = 0
        For c1 = 2 To last_d_1
            For c2 = 0 To lb1i
                If Range("K" & c1).Interior.Color <> &HC000& Then
                  stringsave = Range("G" & c1).Value & "," & Range("H" & c1).Value & ";" & Range("F" & c1).Value
                  userarray(array_user_count) = stringsave
                  array_user_count = array_user_count + 1
                  ReDim Preserve userarray(array_user_count)
                End If
            Next c2
        Next c1
    
        'Anzeige der Differenzen
        If array_user_count = 0 Then
            Sheets("Back").Select
            Range("A33").Value = "ok"
        End If
        If array_user_count > 0 Then
            Dim x12 As Long
            Dim y12 As Long
            Dim objarrlist As Object, l As Long
            Set objarrlist = CreateObject("System.collections.arraylist")
            For l = 0 To UBound(userarray) - 1
                If objarrlist.contains(userarray(l)) = False Then
                    objarrlist.Add userarray(l)
                End If
            Next l
            Erase userarray
            With objarrlist
                .Sort
                userarray = .toarray
            End With
            
            Set objarrlist = Nothing
            Dim z12
            x12 = LBound(userarray)
            y12 = UBound(userarray)
            For z12 = x12 To y12
                Diff.AddItem userarray(z12)
            Next z12
            Diff.Show
        End If
        'Ende der Differenzenanzeige
    End If 'des initialen durchlaufs

Hier will ich eine Fortschrittsanzeige einbauen, die im Vordergrund dem Anwender anzeigt, dass der Differenzenabgleich noch läuft.

Wo müsste ich das wohl einbauen ?

Danke für Eure Hilfe.

Florian

 

Hi Florian,

ich würde das anders lösen: am Anfang eine MsgBox mit dem Hinweis, dass der Vorgang länger dauert. Begründung: durch eine Fortschrittsanzeige wird der Codedurchlauf noch um ein wesentliches weiter verlangsamt.

Bis später
Karin

 

Mh.. gute Idee, man muss gar nicht so kompliziert denken :)
Das werde ich mir nochmals durch den Kopf gehen lassen....