Ich habe ein, wie ich finde, relativ simples Programm, bei dem ich mit der Performance
zu kämpfen habe. 34 Spalten und Zeilen soviele, wie es eben sind. Eine Zeile ist
jeweils ein Fall und pro Fall habe ich die 34 Spalten (Reserve ist eingerechnet).
Reel sinds nur 30 Spalten. Damit ich alle 30 Zellen (in der jeweils aktiven Zeile)
sehe, habe ich eine Userform mit Textboxen und ein paar Comboboxen eingerichtet.
Dann habe ich mittels Code dafür gesorgt, daß die Userform zwar sichtbar, jedoch
immer im Hintergrund bleibt, es sei denn, ich klicke in eine Textbox, dann hat die
logischerweise den Fokus.
Ablauf ist wie folgt: Ich klicke in eine Zelle, er ermittelt diese Zeile und pickt
sich die relevanten 30 Zellen, die in dieser Zeile sind heraus und weist den Inhalt
den Text- / Comboboxen zu und behält den Fokus aber auf den Zellen. Ich kann nun mit
den Pfeiltasten oder der Maus die nächste Zelle auswählen und dasselbe Spiel beginnt
von vorne. Er ermittelt... und weist den Inhalt der Zellen den Boxen zu. Und während er
das macht, sieht man am Mauscursor, daß er mitunter ganz schön ins schwitzen kommt
und ein paar Sekunden kurbelt, obwohl aus meiner Sicht es keine allzu große Rechen-
leistung erfordert.
Bei Textboxen sieht das dann so aus:
'##### Gemäß aktuell aktiver Zelle die komplette Zeile auslesen und Textboxen bzw. Variablen zuweisen #####
frmService.txtMaschinennummer3.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 3).Text
frmService.txtMaschinentyp4.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 4).Text
frmService.txtMaschinenart14.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 14).Text
frmService.txtKunde6.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 6).Text
frmService.txtKundennummer_Kd5.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 5).Text
frmService.txtKundennummer_Vertr31.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 31).Text
frmService.txtOrtLand7.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 7).Text
frmService.txtAnsprechpartner15.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 15).Text
frmService.txtProblembeschrieb9.Text = Worksheets("Tabelle1").Cells(intZelleAktiveZeile, 9).Text
Bei Comboboxen ists da schon ein wenig komplizierter. Für "Problem1" und "Problem2"
meines Programms habe ich jeweils 2 Comboboxen. In die erste kommt die Rubrik und
in die zweite die Details. Wenn ich bei der Rubrik 1 auswähle, zeigt es bei Detail
auch die Items von "1" an. Wenn ich bei Rubrik 2 auswähle, dann zeigts entsprechend
bei Detail auch die Items von "2" an. Da ich im Change Ereignis nicht möchte, daß
die Combobox immer voller wird, muß ich vor dem AddItem erstmal ein RemoveItem
ausführen, da nicht sicher ist, was der Benutzer auswählen wird. Ich denke, der
Quelltext wird es besser erklären können, als ich mit vielen Worten:
Private Sub cboZweiProblemKategorie20_Click()
Dim i As Integer
Dim count As Integer
Dim loeschen As String
intKlickzaehlercboZweiProblemKategorie20 = intKlickzaehlercboZweiProblemKategorie20 + 1
If frmService.cboZweiProblemKategorie20.Value = "1-Motoren" Then '########################## _
_
####### Motoren
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
For i = frmService.cboZweiProblemDetail21.ListCount - 1 To 0 Step -1
frmService.cboZweiProblemDetail21.RemoveItem i
Next i
intKlickzaehlercboZweiProblemKategorie20 = 1
frmService.cboZweiProblemDetail21.Value = ""
End If
frmService.cboZweiProblemDetail21.AddItem "1-AMK"
frmService.cboZweiProblemDetail21.AddItem "1-Beckhoff"
frmService.cboZweiProblemDetail21.AddItem "1-Control Techniques"
frmService.cboZweiProblemDetail21.AddItem "1-E-Mot.werke Brienz"
frmService.cboZweiProblemDetail21.AddItem "1-Lenze"
frmService.cboZweiProblemDetail21.AddItem "1-Rossi"
frmService.cboZweiProblemDetail21.AddItem "1-Siemens"
ElseIf frmService.cboZweiProblemKategorie20.Value = "2-Drives" Then '####################### _
_
########## Drives
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
For i = frmService.cboZweiProblemDetail21.ListCount - 1 To 0 Step -1
frmService.cboZweiProblemDetail21.RemoveItem i
Next i
intKlickzaehlercboZweiProblemKategorie20 = 1
frmService.cboZweiProblemDetail21.Value = ""
End If
frmService.cboZweiProblemDetail21.AddItem "2-AMK"
frmService.cboZweiProblemDetail21.AddItem "2-Beckhoff"
frmService.cboZweiProblemDetail21.AddItem "2-Control Techniques"
frmService.cboZweiProblemDetail21.AddItem "2-Lenze"
frmService.cboZweiProblemDetail21.AddItem "2-Siemens"
frmService.cboZweiProblemDetail21.AddItem "2-andere"
ElseIf frmService.cboZweiProblemKategorie20.Value = "3-Computer" Then '#################### _
_
############# Computer
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
For i = frmService.cboZweiProblemDetail21.ListCount - 1 To 0 Step -1
frmService.cboZweiProblemDetail21.RemoveItem i
Next i
intKlickzaehlercboZweiProblemKategorie20 = 1
frmService.cboZweiProblemDetail21.Value = ""
End If
frmService.cboZweiProblemDetail21.AddItem "3-Beckhoff"
frmService.cboZweiProblemDetail21.AddItem "3-Spektra"
ElseIf frmService.cboZweiProblemKategorie20.Value = "4-EtherCAT / Bus" Then '############## _
_
################### EtherCAT / Bus
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
For i = frmService.cboZweiProblemDetail21.ListCount - 1 To 0 Step -1
frmService.cboZweiProblemDetail21.RemoveItem i
Next i
intKlickzaehlercboZweiProblemKategorie20 = 1
frmService.cboZweiProblemDetail21.Value = ""
End If
frmService.cboZweiProblemDetail21.AddItem "4-AMK"
frmService.cboZweiProblemDetail21.AddItem "4-Beckhoff"
frmService.cboZweiProblemDetail21.AddItem "4-Control Techniques"
frmService.cboZweiProblemDetail21.AddItem "4-Lenze"
frmService.cboZweiProblemDetail21.AddItem "4-Siemens"
ElseIf frmService.cboZweiProblemKategorie20.Value = "5-Schütze / Sicherungen / Relais" Then _
_
'################################# Schütze / Sicherungen / Relais
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
For i = frmService.cboZweiProblemDetail21.ListCount - 1 To 0 Step -1
frmService.cboZweiProblemDetail21.RemoveItem i
Next i
intKlickzaehlercboZweiProblemKategorie20 = 1
frmService.cboZweiProblemDetail21.Value = ""
End If
frmService.cboZweiProblemDetail21.AddItem "5-ABB"
frmService.cboZweiProblemDetail21.AddItem "5-Moeller"
frmService.cboZweiProblemDetail21.AddItem "5-Siemens"
ElseIf frmService.cboZweiProblemKategorie20.Value = "6-Sensoren / Encoder / Poti / _
Endschalter" Then '################################# Sensoren / Encoder / Poti / Endschalter
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
For i = frmService.cboZweiProblemDetail21.ListCount - 1 To 0 Step -1
frmService.cboZweiProblemDetail21.RemoveItem i
Next i
intKlickzaehlercboZweiProblemKategorie20 = 1
frmService.cboZweiProblemDetail21.Value = ""
End If
frmService.cboZweiProblemDetail21.AddItem "6-Balluff"
frmService.cboZweiProblemDetail21.AddItem "6-Baumer"
frmService.cboZweiProblemDetail21.AddItem "6-Moeller"
frmService.cboZweiProblemDetail21.AddItem "6-Sick"
ElseIf frmService.cboZweiProblemKategorie20.Value = "7-Software" Then '#################### _
_
############# Software
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
For i = frmService.cboZweiProblemDetail21.ListCount - 1 To 0 Step -1
frmService.cboZweiProblemDetail21.RemoveItem i
Next i
intKlickzaehlercboZweiProblemKategorie20 = 1
frmService.cboZweiProblemDetail21.Value = ""
End If
frmService.cboZweiProblemDetail21.AddItem "7-Beckhoff"
frmService.cboZweiProblemDetail21.AddItem "7-Control Techniques"
frmService.cboZweiProblemDetail21.AddItem "7-Siemens"
frmService.cboZweiProblemDetail21.AddItem "7-Tuboly-Astronic"
ElseIf frmService.cboZweiProblemKategorie20.Value = "8-mechanische Probleme" Then '######## _
_
######################### mechanische Probleme
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
For i = frmService.cboZweiProblemDetail21.ListCount - 1 To 0 Step -1
frmService.cboZweiProblemDetail21.RemoveItem i
Next i
intKlickzaehlercboZweiProblemKategorie20 = 1
frmService.cboZweiProblemDetail21.Value = ""
End If
frmService.cboZweiProblemDetail21.AddItem "8-Amsler"
frmService.cboZweiProblemDetail21.AddItem "8-Gessmann"
frmService.cboZweiProblemDetail21.AddItem "8-Tuboly-Astronic"
frmService.cboZweiProblemDetail21.AddItem "8-andere"
End If
Dann hab ich noch sowas simples, daß es die Status-Combobox einfärben soll:
Private Sub cboStatusNeu_Change()
If frmService.cboStatusNeu.Value = "1-Erledigt & erfaßt" Then
strStatusAktuell29 = "1"
frmService.cboStatusNeu.BackColor = &HC0FFC0
ElseIf frmService.cboStatusNeu.Value = "2-Erledigt & wird nicht erfaßt" Then
strStatusAktuell29 = "2"
frmService.cboStatusNeu.BackColor = &HE0E0E0
ElseIf frmService.cboStatusNeu.Value = "3-In Bearbeitung durch Tu-As" Then
strStatusAktuell29 = "3"
frmService.cboStatusNeu.BackColor = &HFFFF80
ElseIf frmService.cboStatusNeu.Value = "4-Kundenantwort ausstehend" Then
strStatusAktuell29 = "4"
frmService.cboStatusNeu.BackColor = &HC0E0FF
ElseIf frmService.cboStatusNeu.Value = "5-Sehr hohe Priorität" Then
strStatusAktuell29 = "5"
frmService.cboStatusNeu.BackColor = &H8080FF
ElseIf frmService.cboStatusNeu.Value = "6-Servicebesuch gewünscht" Then
strStatusAktuell29 = "6"
frmService.cboStatusNeu.BackColor = &H80FFFF
ElseIf frmService.cboStatusNeu.Value = "7-Wird vor Ort gelöst" Then
strStatusAktuell29 = "7"
frmService.cboStatusNeu.BackColor = &HFF00&
End If
intStatusGeaendert = 1
cmdSpeichern.SetFocus
End Sub
Ehrlich gesagt habe ich keine Ahnung, was an meinem Code jetzt so stark an der
Performance frißt, daß er so derart kurbeln muß. Ich hoffe, ich habe ich nicht mit zuviel Text überschüttet, wollte es aber euch so genau wie möglich schildern, in
der Hoffnung, ihr könnt mir helfen.
Danke im Voraus.
Gruß Ronald