Zähler in Statusleiste

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Klaus,
das war ein Tippfehler. Es heißt natürlich Application.ScreenUpdating = False.
Ich wollte die 3 Seiten code nicht anhängen. Aber ich kann das gern machen.
Gruß RALF
pfad1 = [pfad]
datei1 = [datei]
Open pfad1 & datei1 For Input As #1
ze = 2
Do Until EOF(1)
Line Input #1, zeile
Sheets("holen").Cells(ze, 1) = zeile
ze = ze + 1
Loop
Close #1
Sheets("holen").Select
Range([A2], [A2].End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), _
Array(26, 1), Array(27, 1), Array(28, 1)), _
TrailingMinusNumbers:=True
If Sheets("holen").Cells(3, 1) = "" Then
MsgBox "Keine Daten vorhanden"
Exit Sub
End If
Sheets("Daten").Select
For i = 2 To Sheets("holen").[A1].End(xlDown).Row
Cells(35 + i, 1) = i
Next
[B37:AZ37].Copy
Range([b37], Cells(35 + Sheets("holen").[A1].End(xlDown).Row, 52)).PasteSpecial
ActiveSheet.Calculate
'---------- Formatierung
Application.ScreenUpdating = False
row_bis = [A37].End(xlDown).Row
For i = 37 To row_bis
Application.StatusBar = "Formatierung läuft: " & i & " / " & row_bis
Cells(i, [ber_vba_ind]).Select
'Formatierung "Ind"
HV = Cells(i, [ber_vba_hv])
kundeinfo = Cells(i, [ber_vba_kunde])
cluster = Cells(i, [ber_vba_cluster])
kat = Left(Cells(i, [ber_vba_kat]), 10)
schadart = Cells(i, [ber_vba_schadart])
erstelldatum = Cells(i, [ber_vba_erstellt])
geloescht = IIf(Cells(i, [ber_vba_geloescht]) = "0", "", Cells(i, [ber_vba_geloescht]))
rg_format (format_index(HV, kundeinfo, cluster, kat, schadart, erstelldatum, geloescht))
'Formatierung "Wertung"
If geloescht = "" And Cells(i, [ber_vba_hv]) = "Halter_80000" Then
If Not Cells(Selection.Row, [ber_vba_kunde]) = "" Then
suchwert = Trim(Cells(Selection.Row, [ber_vba_kunde]))
suchwert = IIf(suchwert = "", "leer", suchwert)
erg = rg_format_wertung(suchwert, "ber_eintr_kunde", 4, Selection.Row, [ber_vba_wertung])
Else
If Not Cells(Selection.Row, [ber_vba_cluster]) = "" Then
suchwert = Trim(Cells(Selection.Row, [ber_vba_cluster]))
suchwert = IIf(suchwert = "", "leer", suchwert)
erg = rg_format_wertung(suchwert, "ber_eintr_cluster", 3, Selection.Row, [ber_vba_wertung])
End If
End If
End If
Next i
Application.ScreenUpdating = True
Application.StatusBar = False
A36].Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.sORT Key1:=Range("C37"), Key2:=Range("F37"), Order1:=xlAscending, Order2:=xlAscending, _
OrderCustom:=1, Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
[G37].Select
Rows("37:37").EntireRow.AutoFit

Hi Ralf,
die .select aus deinem Code kannst du alle rationalisieren, die sind nicht notwendig.
Ich kürz mal wieder runter: Dein Counter läuft hier und begleitet (Code B):


[CODE A]
For i = 37 To row_bis
Application.StatusBar = "Formatierung läuft: " & i & " / " & row_bis
[CODE B]
Next i
[CODE C]

Du hast vorher ne ganze Menge langsamen Code (Code A) und nachher auch (Code C).
In (Code A) ist zumindest ein LOOP unbekannter Laufzeit,
in (Code C) immerhin noch ein sortieren-TextInSpalten mit selects.
Nochmal zum Nachvollziehen: Dein Problem ist, dass der Counter in der Statusbar während er CodeB begleitet nicht mehr mitläuft? Das er während der Ausführung von Teil A und Teil C nicht läuft ist klar?
Wenn du schreibst,
Codeabschnitt (Zähler und Formatierung) alleine laufen lassen, dann funktioniert das.
Welchen Codeabschnitt meinst du dann genau? Präzise: Hast du das "Screenupdating=False" in diesem Codeabschnitt drin, der läuft?
(Ich nutze einen änlichen Counter über die Statusbar in einem wesentlich umfangreicherem Code und hatte damit nie Probleme)
Grüße,
Klaus M.vdT.

Function rg_format_wertung(sSuchFormatWert As String, sBerFormatWert As String, _ iSpIndFormatWert As Integer, rowFormatWert, colFormatWert) Dim arrFormatWert As Variant 'Arraydefinition (gilt für Wagen Halter 80000) 'Array(0) = Fehler(0) oder Muster nein(1 = xlsolid) oder ja (2) 'Array(1) = ColorIndex = Farbe Hintergrund bei Pattern = xlSolid 'Array(2) = Pattern = Art des Musters (Patterm) 'Array(3) = PatternColorIndex = Farbe Hintergrund 2 bei Pattern xlsolid ' ColorIndex Pattern PatternColorIndex Farbe 'wert_hg 35 1 0 hellgrün 'wert_gr 4 1 0 grün 'wert_ge 44 1 0 gelb (orange) 'wert_rs 0 13 3 rot schraffiert 'wert_nix 0 0 0 ohne 'wert_ro 3 1 0 rot 'HV = Cells(i, [ber_vba_hv]) --> nur für "Halter_80000" (Verdichtung) If Cells(rowFormatWert, [ber_vba_hv]) = "Halter_80000" Then arrFormatWert = Array(0) Select Case WorksheetFunction.VLookup(sSuchFormatWert, Range(sBerFormatWert), _ iSpIndFormatWert, 0) Case Is = "wert_hg" arrFormatWert = Array(1, "offen (hellgrün)", 35, 1) Case Is = "wert_gr" arrFormatWert = Array(1, "abrechenbar (grün)", 4, 1) Case Is = "wert_ge" arrFormatWert = Array(1, "Kunde (gelb)", 44, 1) Case Is = "wert_rs" arrFormatWert = Array(2, "Neuschaden - nicht erkannt (rot schraffiert)", 0, 13, 3) Case Is = "wert_nix" arrFormatWert = Array(1, "k.W. (weiß)", 0, 0) Case Is = "wert_ro" arrFormatWert = Array(1, "Produktion (rot)", 3, 1) End Select Select Case arrFormatWert(0) Case Is = 0 rg_format_wertung = "FEHLER FORMAT #101 - Kontaktieren Sie Ihren Administrator!" Case Is = 1 With Cells(rowFormatWert, colFormatWert).Interior .ColorIndex = arrFormatWert(2) .Pattern = arrFormatWert(3) End With Cells(rowFormatWert, colFormatWert).Font.ColorIndex = IIf(arrFormatWert(2) = 0, 2, _ arrFormatWert(2)) Cells(rowFormatWert, colFormatWert) = arrFormatWert(1) rg_format_wertung = "OK" Case Is = 2 With Cells(rowFormatWert, colFormatWert).Interior .ColorIndex = arrFormatWert(2) .Pattern = arrFormatWert(3) .PatternColorIndex = arrFormatWert(4) End With Cells(rowFormatWert, colFormatWert).Font.ColorIndex = IIf(arrFormatWert(2) = 0, 2, _ arrFormatWert(2)) Cells(rowFormatWert, colFormatWert) = arrFormatWert(1) rg_format_wertung = "OK" Case Else rg_format_wertung = "FEHLER FORMAT #202 - Kontaktieren Sie Ihren Administrator!" End Select End If End Function

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread