Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1612to1616
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Performanche beim simplen Auslesen

Performanche beim simplen Auslesen
22.03.2018 22:51:53
Ronald
Hallo an alle!
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Performanche beim simplen Auslesen
23.03.2018 01:49:44
fcs
Hallo Ronald,
wahrscheinlich kommt es zu Rückkopplungs-Effekten, d.h. durch die Änderungen an den Werten der Combobox durch das Ereignis-Makro wird das Click-Ereignis mehrfach aufgerufen und verfängt sich in einer Schleife.
Das kann man dadurch verhindern, dass man im Modul eine Steuervariable Deklariert.
Diese hat normalerweise den Wert False.
Zu Beginn des Ereignismakros wird ihr Wert auf True geprüft, Falls Wert = True, dann wird das Ereignismakro sofort wieder verlassen, falls Wert = False, dann läuft das Makro weiter.
Jetzt wird der Wert der Steuervariablen auf True gesetzt.
Vor dem Beenden des Ereignis-Makros wird die Stervariable wieder auf False gesetzt.
So wird sichergestellt, dass das Ereignnismakro nur einmal komplett ausgeführt wird.
Ansonsten kann man deine Makros noch etwas schöner Programmieren.
Zum Löschen aller Items einer Combo/Listbox muss man nicht die Items einzeln entfernen. Dafür gibt es die Clear-Methode.
Zum Füllen der Auswahlliste kann man alternativ zu AddItem auch der List-Eigenschaft ein Array mit den Einträgen zuweisen.
Mit With ObjektXYZ ... End With erspart man sich das Ständige wiederholen der Objekt-Bezeichnung.
Der Einsatz von Select Case ist hier effektiver/übersichtlicher als If ... Elseif...
Gruß
Franz
'Code zum Füllen der Textboxen
'##### Gemäß aktuell aktiver Zelle die komplette Zeile auslesen und Textboxen bzw. _
Variablen zuweisen #####
With Worksheets("Tabelle1")
frmService.txtMaschinennummer3.Text = .Cells(intZelleAktiveZeile, 3).Text
frmService.txtMaschinentyp4.Text = .Cells(intZelleAktiveZeile, 4).Text
frmService.txtMaschinenart14.Text = .Cells(intZelleAktiveZeile, 14).Text
frmService.txtKunde6.Text = .Cells(intZelleAktiveZeile, 6).Text
frmService.txtKundennummer_Kd5.Text = .Cells(intZelleAktiveZeile, 5).Text
frmService.txtKundennummer_Vertr31.Text = .Cells(intZelleAktiveZeile, 31).Text
frmService.txtOrtLand7.Text = .Cells(intZelleAktiveZeile, 7).Text
frmService.txtAnsprechpartner15.Text = .Cells(intZelleAktiveZeile, 15).Text
frmService.txtProblembeschrieb9.Text = .Cells(intZelleAktiveZeile, 9).Text
End With
'Code im Userm frmService
'Deklaration der Steuervariablen oben im Code-Modul von frmService
Private bolAenderung As Boolean
Private Sub cboZweiProblemKategorie20_Click()
'Steuervariable prüfen
If bolAenderung = True Then Exit Sub
bolAenderung = True 'Steuervariable auf True setzen
Dim i As Integer
Dim count As Integer
Dim loeschen As String
Dim arrList
intKlickzaehlercboZweiProblemKategorie20 = intKlickzaehlercboZweiProblemKategorie20 + 1
With frmService.cboZweiProblemDetail21
If frmService.cboZweiProblemKategorie20.Text  "" Then
If intKlickzaehlercboZweiProblemKategorie20 = 2 Then
.Clear
intKlickzaehlercboZweiProblemKategorie20 = 1
.Value = ""
End If
Select Case frmService.cboZweiProblemKategorie20.Value
Case "1-Motoren"  '################################# Motoren
arrList = Array("1-AMK", "1-Beckhoff", "1-Control Techniques", _
"1-E-Mot.werke Brienz", "1-Lenze", "1-Rossi", "1-Siemens")
.List = arrList
Case "2-Drives" '################################# Drives
arrList = Array("2-AMK", "2-Beckhoff", "2-Control Techniques", "2-Lenze", _
"2-Siemens", "2-andere")
.List = arrList
Case "3-Computer" '################################# Computer
arrList = Array("3-Beckhoff", "3-Spektra")
.List = arrList
Case "4-EtherCAT / Bus"   '################################# EtherCAT / Bus
arrList = Array("4-AMK", "4-Beckhoff", "4-Control Techniques", "4-Lenze", _
"4-Siemens")
.List = arrList
Case "5-Schütze / Sicherungen / Relais" ' _
################################# Schütze / Sicherungen / Relais
arrList = Array("5-ABB", "5-Moeller", "5-Siemens")
.List = arrList
Case "6-Sensoren / Encoder / Poti / Endschalter"  ' _
################################# Sensoren / Encoder / Poti / Endschalter
arrList = Array("6-Balluff", "6-Baumer", "6-Moeller", "6-Sick")
.List = arrList
Case "7-Software"  '################################# Software
arrList = Array("7-Beckhoff", "7-Control Techniques", "7-Siemens", _
"7-Tuboly-Astronic")
.List = arrList
Case "8-mechanische Probleme" '################################# mechanische Probleme
arrList = Array("8-Amsler", "8-Gessmann", "8-Tuboly-Astronic", "8-andere")
.List = arrList
End Select
End If
End With
bolAenderung = False 'Steuervariable auf False zurücksetzen
End Sub
Private Sub cboStatusNeu_Change()
With frmService.cboStatusNeu
Select Case .Value
Case "1-Erledigt & erfaßt"
strStatusAktuell29 = "1"
.BackColor = &HC0FFC0
Case "2-Erledigt & wird nicht erfaßt"
strStatusAktuell29 = "2"
.BackColor = &HE0E0E0
Case "3-In Bearbeitung durch Tu-As"
strStatusAktuell29 = "3"
.BackColor = &HFFFF80
Case "4-Kundenantwort ausstehend"
strStatusAktuell29 = "4"
.BackColor = &HC0E0FF
Case "5-Sehr hohe Priorität"
strStatusAktuell29 = "5"
.BackColor = &H8080FF
Case "6-Servicebesuch gewünscht"
strStatusAktuell29 = "6"
.BackColor = &H80FFFF
Case "7-Wird vor Ort gelöst"
strStatusAktuell29 = "7"
.BackColor = &HFF00&
End Select
End With
intStatusGeaendert = 1
cmdSpeichern.SetFocus
End Sub

Anzeige
AW: Performanche beim simplen Auslesen
23.03.2018 06:12:55
Ronald
Grüß Dich Franz
Vielen Dank für die schnelle Antwort. Klingt sehr gut. Ehrlich gesagt habe ich mit Arrays bis
jetzt noch nicht viel zu tun gehabt. Auch mit dem beiden Schleifen For-next und Select-case habe
ich mich bisher recht schwer getan. Was man nicht kennt, nutzt man nicht. Aber ich werde mir
das mal ansehen. Vielen Dank auch für den abgeänderten Code. Nun sehe ich gleich, wie Du es
meintest.
Danke schön!
Gruß Ronald
AW: Performanche beim simplen Auslesen
26.03.2018 20:33:24
Ronald
Grüß Dich Franz
Ich habe die Änderungen übernommen, aber es ist immer noch lahm. Mit durchdebuggen komme
ich leider auch nicht weiter. Vielleicht habe ich einige grundsätzliche Fehler aus Unwissenheit
drin.
Der aktuelle Code bezieht sich auf Tabelle1, und ist nicht nur im Modul, sondern auch in der
Userform und in "Diese Arbeitsmappe" zu finden.
Wäre wirklich schön, wenn Du Dir den kompletten Code mal anschauen könntest. Oder jemand anderes
hier im Forum.
Huch, jetzt habe ich gemerkt, ich kann es nicht hochladen. Bitte gebt mir vorher einen Tip, wie
ich Euch das komplette Excel als xlsm zukommen lassen kann. Ich dachte, ich kann es hier im
Upload hochladen. Aber das geht nicht. Sicherlich ist diese Funktion für etwas anderes gedacht.
Oder soll ich den kompletten Quelltext hier reinschieben? Bringt aus meiner Sicht wenig, da
Ihr dann die Userform nicht sehen könnt, da Ihr die nicht habt. Dann ist Testen schwierig.
Oder soll ich es jemanden per E-Mail schicken?
Danke im Voraus.
Gruß Ronald
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige