AW: Application.ScreenUpdating = false
13.12.2012 17:38:45
RALF
Servus Klaus,
der Zähler läuft im Abschnitt B mit. ScreenUpdating wird ausgeschaltet, der Zähler läuft los, wenn Formatierungsschleife fertig, dann ScrrenUpdating wieder an und Zähler weg.
Ich meine, ich habe das Problem, seitdem ich diesen Teil eingefügt habe. Also werden in Summe 3 selbst definierte Funktionen genutzt.
Vielleicht hast Du 'ne Idee.
DANKE UND GRUß
RALF
neuer Codeabschnitt
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])
die Funktion habe ich hier
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