Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
824to828
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
824to828
824to828
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro läuft zu langsam

Makro läuft zu langsam
10.12.2006 12:59:22
Dieterlem
Hallo Excelfreunde,
ich habe eine Exceldatei in der ich eine Userform nutze um die Eintragungen in die Zellen zu vereinfachen. Dabei ist die Userform wie eine Eingabemaske ähnlich wie in Access aufgebaut. Die Werte werden auch zügig in die Zellen eingetragen. Wenn ich jedoch eine neue Person laden will startet das Makro Werte_laden() und das dauert mir etwas zu lange. Dabei werden recht viele Werte aus verschiedenen Tabellen in die Userform geladen Wie könnte ich das folgende Makro beschleunigen?
Option Explicit
Public RowNR As Integer

Private Sub Werte_laden()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Page Persdaten
With Sheets(1)
tboNachname = .Cells(RowNR, 2)
tboVorname = .Cells(RowNR, 3)
cboDstGrd2 = .Cells(RowNR, 4)
tboPK = .Cells(RowNR, 5)
tboAbwesenheit = .Cells(RowNR, 33)
tboTE = .Cells(RowNR, 12)
tboDstBeginn = .Cells(RowNR, 13)
tboDstEnde = .Cells(RowNR, 11)
lblPFTAK = .Cells(RowNR, 19)
lblDSAAK = .Cells(RowNR, 20)
lblAlterKj = .Cells(RowNR, 21)
lblAlterHeute = Format(.Cells(RowNR, 25), "yy")
If UCase(.Cells(RowNR, 10)) = "BS" Then
obuBS = True
ElseIf UCase(.Cells(RowNR, 10)) = "SAZ" Then
obuSAZ = True
ElseIf UCase(.Cells(RowNR, 10)) = "FWDL" Then
obuFWDL = True
ElseIf UCase(.Cells(RowNR, 10)) = "GWDL" Then
obuGWDL = True
Else
obuBS = False
obuSAZ = False
obuFWDL = False
obuGWDL = False
End If
If UCase(.Cells(RowNR, 7)) = "M" Then
obuMännlich = True
ElseIf UCase(.Cells(RowNR, 7)) = "W" Then
obuWeiblich = True
Else
obuMännlich = False
obuWeiblich = False
End If
If UCase(.Cells(RowNR, 34)) = "X" Then
chboWertung = True
Else
chboWertung = False
End If
If UCase(.Cells(RowNR, 35)) = "J" Then
chboAMilA = True
chboAmila2 = True
Else
chboAMilA = False
chboAmila2 = False
lblAmilaE = "Der Soldat ist nicht zur Teilnahme verpflichtet"
End If
End With
'Kopf
lblName = "Name: " & tboNachname & ", " & tboVorname
lblDstGrd = "DstGrd: " & Sheets(1).Cells(RowNR, 4)
lblAKDSA = "AK DSA: " & lblDSAAK
lblAKPFT = "AK PFT:  " & lblPFTAK
If UCase(Sheets(1).Cells(RowNR, 32)) = "DZE" Then
lblAbg = "Abgänger"
frKopf.BackColor = &H80C0FF
lblName.BackColor = &H80C0FF
lblDstGrd.BackColor = &H80C0FF
lblAKDSA.BackColor = &H80C0FF
lblAKPFT.BackColor = &H80C0FF
lblAbg.BackColor = &H80C0FF
lblGeschlecht.BackColor = &H80C0FF
lblStatus.BackColor = &H80C0FF
Else
lblAbg = "Im Dienst"
frKopf.BackColor = &H8000000F
lblName.BackColor = &H8000000F
lblDstGrd.BackColor = &H8000000F
lblAKDSA.BackColor = &H8000000F
lblAKPFT.BackColor = &H8000000F
lblAbg.BackColor = &H8000000F
lblGeschlecht.BackColor = &H8000000F
lblStatus.BackColor = &H8000000F
End If
If obuWeiblich = True Then
lblGeschlecht = "Geschlecht: weiblich"
ElseIf obuMännlich = True Then
lblGeschlecht = "Geschlecht: männlich"
End If
If obuBS = True Then
lblStatus = "Status: BS"
ElseIf obuSAZ = True Then
lblStatus = "Status: SAZ"
ElseIf obuFWDL = True Then
lblStatus = "Status: FWDL"
ElseIf obuGWDL = True Then
lblStatus = "Status: GWDL"
End If
'Page DSA
With Sheets(4)
tbo200mSchwW = .Cells(RowNR, 12)
tbo200mSchwD = Format(.Cells(RowNR, 13), "dd.mm.yy")
tboHochW = .Cells(RowNR, 15)
tboHochD = Format(.Cells(RowNR, 17), "dd.mm.yy")
tboWeitW = .Cells(RowNR, 18)
tboWeitD = Format(.Cells(RowNR, 20), "dd.mm.yy")
tboStandweitW = .Cells(RowNR, 21)
tboStandweitD = Format(.Cells(RowNR, 23), "dd.mm.yy")
If UCase(.Cells(RowNR, 24)) = "J" Then
chboPferdW = True
Else
chboPferdW = False
End If
tboPferdD = Format(.Cells(RowNR, 26), "dd.mm.yy")
tbo50mLaufW = .Cells(RowNR, 28)
tbo50mLaufD = Format(.Cells(RowNR, 30), "dd.mm.yy")
tbo75mLaufW = .Cells(RowNR, 31)
tbo75mLaufD = Format(.Cells(RowNR, 33), "dd.mm.yy")
tbo100mLaufW = .Cells(RowNR, 34)
tbo100mLaufD = Format(.Cells(RowNR, 36), "dd.mm.yy")
tbo400mLaufW = .Cells(RowNR, 37)
tbo400mLaufD = Format(.Cells(RowNR, 39), "dd.mm.yy")
tbo1000mLaufW = .Cells(RowNR, 40)
tbo1000mLaufD = Format(.Cells(RowNR, 42), "dd.mm.yy")
tbo3InlineW = .Cells(RowNR, 43)
tbo3InlineD = Format(.Cells(RowNR, 45), "dd.mm.yy")
tboKugelW = .Cells(RowNR, 47)
tboKugelD = Format(.Cells(RowNR, 49), "dd.mm.yy")
tboSteinW = .Cells(RowNR, 50)
tboSteinD = Format(.Cells(RowNR, 52), "dd.mm.yy")
tboSchlagbW = .Cells(RowNR, 53)
tboSchlagbD = Format(.Cells(RowNR, 55), "dd.mm.yy")
tboWurfbW = .Cells(RowNR, 56)
tboWurfbD = Format(.Cells(RowNR, 58), "dd.mm.yy")
tboSchleuderbW = .Cells(RowNR, 59)
tboSchleuderbD = Format(.Cells(RowNR, 61), "dd.mm.yy")
tbo100mSchwW = .Cells(RowNR, 62)
tbo100mSchwD = Format(.Cells(RowNR, 64), "dd.mm.yy")
If UCase(.Cells(RowNR, 65)) = "J" Then
chboTurnW = True
Else
chboTurnW = False
End If
tboTurnD = Format(.Cells(RowNR, 67), "dd.mm.yy")
If UCase(.Cells(RowNR, 68)) = "J" Then
chboBankdW = True
Else
chboBankdW = False
End If
tboBankdD = Format(.Cells(RowNR, 70), "dd.mm.yy")
If UCase(.Cells(RowNR, 71)) = "J" Then
chboGewichtW = True
Else
chboGewichtW = False
End If
tboGewichtD = Format(.Cells(RowNR, 73), "dd.mm.yy")
If UCase(.Cells(RowNR, 74)) = "J" Then
chbo4ZusatzW = True
Else
chbo4ZusatzW = False
End If
tbo4ZusatzD = Format(.Cells(RowNR, 76), "dd.mm.yy")
tbo3000mLaufW = .Cells(RowNR, 78)
tbo3000mLaufD = Format(.Cells(RowNR, 80), "dd.mm.yy")
tbo5000mLaufW = .Cells(RowNR, 81)
tbo5000mLaufD = Format(.Cells(RowNR, 83), "dd.mm.yy")
tboRadW = .Cells(RowNR, 84)
tboRadD = Format(.Cells(RowNR, 86), "dd.mm.yy")
tbo5InlineW = .Cells(RowNR, 87)
tbo5InlineD = Format(.Cells(RowNR, 89), "dd.mm.yy")
tbo1000mSchwW = .Cells(RowNR, 90)
tbo1000mSchwD = Format(.Cells(RowNR, 92), "dd.mm.yy")
tboSkiW = .Cells(RowNR, 93)
tboSkiD = Format(.Cells(RowNR, 95), "dd.mm.yy")
If UCase(.Cells(RowNR, 97)) = "J" Then
chbo5ZusatzW = True
Else
chbo5ZusatzW = False
End If
tbo5ZusatzD = Format(.Cells(RowNR, 99), "dd.mm.yy")
tbo5ZusatzBem = .Cells(RowNR, 96)
'DSA bestanden
If .Cells(RowNR, 5) = "JA" Then
lblDSAbestanden = "bestanden"
ElseIf .Cells(RowNR, 5) = "NEIN" Then
lblDSAbestanden = "nicht bestanden"
ElseIf .Cells(RowNR, 5) = "n.t." Then
lblDSAbestanden = "nicht teilgenommen"
ElseIf .Cells(RowNR, 5) = "f.D." Then
lblDSAbestanden = "fehlende Disziplinen"
End If
End With
Call DSA_bestanden
'Page PFT
With Sheets(3)
'PFT1
tboPFT1D = Format(.Cells(RowNR, 5), "dd.mm.yy")
tboPFT1PendelW = .Cells(RowNR, 9)
tboPFT1SitupW = .Cells(RowNR, 13)
tboPFT1StandwW = .Cells(RowNR, 17)
tboPFT1LiegestW = .Cells(RowNR, 21)
tboPFT112mFW = .Cells(RowNR, 26)
tboPFT112mHW = .Cells(RowNR, 25)
'PFT2
tboPFT2D = Format(.Cells(RowNR, 37), "dd.mm.yy")
tboPFT2PendelW = .Cells(RowNR, 41)
tboPFT2SitupW = .Cells(RowNR, 45)
tboPFT2StandwW = .Cells(RowNR, 49)
tboPFT2LiegestW = .Cells(RowNR, 53)
tboPFT212mFW = .Cells(RowNR, 58)
tboPFT212mHW = .Cells(RowNR, 57)
End With
'Page Marsch
With Sheets(2)
lblMAK = "In der Altersklasse " & lblDSAAK & " werden für Bronze " & .Cells(RowNR, 5) & "km, für Silber " & _
.Cells(RowNR, 7) & "km und für Gold " & .Cells(RowNR, 9) & "km benötigt."
tboM1S = .Cells(RowNR, 11)
tboM2S = .Cells(RowNR, 20)
tboM3S = .Cells(RowNR, 29)
tboM4S = .Cells(RowNR, 41)
tboM5S = .Cells(RowNR, 50)
tboM6S = .Cells(RowNR, 59)
tboM7S = .Cells(RowNR, 70)
tboM8S = .Cells(RowNR, 79)
tboM9S = .Cells(RowNR, 88)
tboM10S = .Cells(RowNR, 99)
tboM11S = .Cells(RowNR, 108)
tboM12S = .Cells(RowNR, 117)
tboM1Z = Format(.Cells(RowNR, 14), "h:mm")
tboM2Z = Format(.Cells(RowNR, 23), "h:mm")
tboM3Z = Format(.Cells(RowNR, 32), "h:mm")
tboM4Z = Format(.Cells(RowNR, 44), "h:mm")
tboM5Z = Format(.Cells(RowNR, 53), "h:mm")
tboM6Z = Format(.Cells(RowNR, 62), "h:mm")
tboM7Z = Format(.Cells(RowNR, 73), "h:mm")
tboM8Z = Format(.Cells(RowNR, 82), "h:mm")
tboM9Z = Format(.Cells(RowNR, 91), "h:mm")
tboM10Z = Format(.Cells(RowNR, 102), "h:mm")
tboM11Z = Format(.Cells(RowNR, 111), "h:mm")
tboM12Z = Format(.Cells(RowNR, 120), "h:mm")
tboM1D = Format(.Cells(RowNR, 15), "dd.mm.")
tboM2D = Format(.Cells(RowNR, 24), "dd.mm.")
tboM3D = Format(.Cells(RowNR, 33), "dd.mm.")
tboM4D = Format(.Cells(RowNR, 45), "dd.mm.")
tboM5D = Format(.Cells(RowNR, 54), "dd.mm.")
tboM6D = Format(.Cells(RowNR, 63), "dd.mm.")
tboM7D = Format(.Cells(RowNR, 74), "dd.mm.")
tboM8D = Format(.Cells(RowNR, 83), "dd.mm.")
tboM9D = Format(.Cells(RowNR, 92), "dd.mm.")
tboM10D = Format(.Cells(RowNR, 103), "dd.mm.")
tboM11D = Format(.Cells(RowNR, 112), "dd.mm.")
tboM12D = Format(.Cells(RowNR, 121), "dd.mm.")
End With
'Page Leistungsabzeichen
With Sheets(7)
tboLstAbzSanD = Format(.Cells(RowNR, 8), "dd.mm.yy")
tboLstAbzSanE = .Cells(RowNR, 9)
tboLstAbzSanA = .Cells(RowNR, 10)
If .Cells(RowNR, 25) <> "n.erf" Then
tboLstAbzME = .Cells(RowNR, 25) & " am " & .Cells(RowNR, 28)
ElseIf .Cells(RowNR, 25) = "n.erf" Then
tboLstAbzME = "nicht erfüllt"
Else
tboLstAbzME = ""
End If
tboLstAbzSchD = Format(.Cells(RowNR, 34), "dd.mm.yy")
If UCase(.Cells(RowNR, 32)) = "G" Then
cboLstAbzSchW = "Gewehr"
ElseIf UCase(.Cells(RowNR, 32)) = "P" Then
cboLstAbzSchW = "Pistole"
ElseIf UCase(.Cells(RowNR, 32)) = "MG" Then
cboLstAbzSchW = "Maschinengewehr"
ElseIf UCase(.Cells(RowNR, 32)) = "MP" Then
cboLstAbzSchW = "Maschinenpistole"
End If
tboLstAbzSchA = .Cells(RowNR, 35)
If UCase(.Cells(RowNR, 30)) = "G" Then
cboLstAbzSchS = "Gold"
ElseIf UCase(.Cells(RowNR, 30)) = "S" Then
cboLstAbzSchS = "Silber"
ElseIf UCase(.Cells(RowNR, 30)) = "B" Then
cboLstAbzSchS = "Bronze"
Else
cboLstAbzSchS = "---"
End If
tboLstAbzBeuD = Format(.Cells(RowNR, 40), "dd.mm.yy")
tboLstAbzBeuA = .Cells(RowNR, 41)
End With
'Page AMilA
With Sheets(29)
If UCase(.Cells(RowNR, 8)) = "J" Then
obuAmila1Erf = True
obuAmila1Nerf = False
frAmila1.ForeColor = &HC000&
ElseIf UCase(.Cells(RowNR, 8)) = "N" Then
obuAmila1Erf = False
obuAmila1Nerf = True
frAmila1.ForeColor = &HFF&
Else
obuAmila1Erf = False
obuAmila1Nerf = False
frAmila1.ForeColor = &H80000012
End If
tboAmila1D = Format(.Cells(RowNR, 9), "dd.mm.yy")
If UCase(.Cells(RowNR, 10)) = "J" Then
obuAmila2Erf = True
obuAmila2Nerf = False
frAmila2.ForeColor = &HC000&
ElseIf UCase(.Cells(RowNR, 10)) = "N" Then
obuAmila2Erf = False
obuAmila2Nerf = True
frAmila2.ForeColor = &HFF&
Else
obuAmila2Erf = False
obuAmila2Nerf = False
frAmila2.ForeColor = &H80000012
End If
tboAmila2D = Format(.Cells(RowNR, 11), "dd.mm.yy")
If obuAmila1Erf = True And obuAmila2Erf = True Then
lblAmilaE = "erfüllt"
lblAmilaE.ForeColor = &HC000&
ElseIf obuAmila1Nerf = True Or obuAmila2Nerf = True Then
lblAmilaE = "nicht erfüllt"
lblAmilaE.ForeColor = &HFF&
Else
lblAmilaE.ForeColor = &H80000012
End If
End With
'Page Sonstige Abzeichen
With Sheets(13)
tboSonstS1D = Format(.Cells(RowNR, 5), "dd.mm.yy")
tboSonstS2D = Format(.Cells(RowNR, 6), "dd.mm.yy")
tboSonstS3D = Format(.Cells(RowNR, 7), "dd.mm.yy")
tboSonstS4D = Format(.Cells(RowNR, 8), "dd.mm.yy")
tboSonstS5D = Format(.Cells(RowNR, 9), "dd.mm.yy")
tboSonstSMD = Format(.Cells(RowNR, 10), "dd.mm.yy")
tboSonstSW1D = Format(.Cells(RowNR, 11), "dd.mm.yy")
tboSonstSW2D = Format(.Cells(RowNR, 12), "dd.mm.yy")
tboSonstBem = .Cells(RowNR, 13)
End With
'Page Organisatorisches
With Sheets(4)
tboDsaAntrAusgD = Format(.Cells(RowNR, 105), "dd.mm.yy")
tboDsaAntrAbgD = Format(.Cells(RowNR, 106), "dd.mm.yy")
tboDsaUrkED = Format(.Cells(RowNR, 107), "dd.mm.yy")
tboDsaBwUrkD = Format(.Cells(RowNR, 108), "dd.mm.yy")
tboDsaDSBNr = .Cells(RowNR, 109)
tboDsaJahr = .Cells(RowNR, 110)
If UCase(.Cells(RowNR, 111)) = "G" Then
cboDsaS = "Gold"
ElseIf UCase(.Cells(RowNR, 111)) = "S" Then
cboDsaS = "Silber"
ElseIf UCase(.Cells(RowNR, 111)) = "B" Then
cboDsaS = "Bronze"
Else
cboDsaS = "---"
End If
tboDsaW = .Cells(RowNR, 112)
End With
With Sheets(7)
tboLstAbzAntrD = Format(.Cells(RowNR, 44), "dd.mm.yy")
tboLstAbzJahr = .Cells(RowNR, 45)
If UCase(.Cells(RowNR, 46)) = "G" Then
cboLstAbzS = "Gold"
ElseIf UCase(.Cells(RowNR, 46)) = "S" Then
cboLstAbzS = "Silber"
ElseIf UCase(.Cells(RowNR, 46)) = "B" Then
cboLstAbzS = "Bronze"
Else
cboLstAbzS = "---"
End If
tboLstAbzW = .Cells(RowNR, 47)
End With
SpinButton1.Value = RowNR
Sheets(20).Range("X111") = ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

'''''''' BESTANDEN PRÜFEN '''''''''''''''''''''''''''''''''''
Sub DSA_bestanden()
'Gruppe1 farblich markieren ob bestanden
With Sheets(4)
If .Cells(RowNR, 11) = 1 Then
frDSA1.ForeColor = &HC000&
ElseIf .Cells(RowNR, 11) = 0 Then
frDSA1.ForeColor = &HFF&
Else
frDSA1.ForeColor = &H80000012
End If
'Gruppe2 farblich markieren ob bestanden
If .Cells(RowNR, 14) = 1 Then
frDSA2.ForeColor = &HC000&
ElseIf .Cells(RowNR, 14) = 0 Then
frDSA2.ForeColor = &HFF&
Else
frDSA2.ForeColor = &H80000012
End If
'Gruppe3 farblich markieren ob bestanden
If .Cells(RowNR, 27) = 1 Then
frDSA3.ForeColor = &HC000&
ElseIf .Cells(RowNR, 27) = 0 Then
frDSA3.ForeColor = &HFF&
Else
frDSA3.ForeColor = &H80000012
End If
'Gruppe4 farblich markieren ob bestanden
If .Cells(RowNR, 46) = 1 Then
frDSA4.ForeColor = &HC000&
ElseIf .Cells(RowNR, 46) = 0 Then
frDSA4.ForeColor = &HFF&
Else
frDSA4.ForeColor = &H80000012
End If
'Gruppe5 farblich markieren ob bestanden
If .Cells(RowNR, 77) = 1 Then 'bestanden = grün
frDSA5.ForeColor = &HC000&
ElseIf .Cells(RowNR, 77) = 0 Then 'nicht bestanden = rot
frDSA5.ForeColor = &HFF&
Else
frDSA5.ForeColor = &H80000012 '= schwarz
End If
If UCase(.Cells(RowNR, 5)) = "JA" Then lblDSAbestanden = "bestanden"
End With
End Sub
Gruß
Dieterlem

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro läuft zu langsam
10.12.2006 13:26:34
Nepumuk
Hallo Dieterlem,
die Prozedur ist nicht langsam, sondern du machst zuviel Unsinn darin. Z.B.
If UCase(.Cells(RowNR, 7)) = "M" Then
    obuMännlich = True
ElseIf UCase(.Cells(RowNR, 7)) = "W" Then
    obuWeiblich = True
Else
    obuMännlich = False
    obuWeiblich = False
End If

If obuWeiblich = True Then
    lblGeschlecht = "Geschlecht: weiblich"
ElseIf obuMännlich = True Then
    lblGeschlecht = "Geschlecht: männlich"
End If

Wozu dieser nutzlose und zeitraubende Umweg über eine Variable?
Nachdem du die Daten anscheinend alle aus einer Zeile holst, lade die Zeile in ein Array und arbeite aus dem Array. Das ist schon wesentlich schneller.
Screenupdating und Calculation auszuschalten kannst du die übrigens sparen, das hat null Effekt in einem Userform.
Gruß
Nepumuk
Anzeige
AW: Makro läuft zu langsam
10.12.2006 13:40:59
Dieterlem
Hallo Nepomuk,
genau um diesen Unsinn geht es mir. Ich möchte das Makro verbessern.
Zitat:
Nachdem du die Daten anscheinend alle aus einer Zeile holst, lade die Zeile in ein Array und arbeite aus dem Array. Das ist schon wesentlich schneller.
Wie kann ich die Zeile in ein Array laden und damit arbeiten?
Gruß
Dieterlem
AW: Makro läuft zu langsam
10.12.2006 13:43:24
Daniel
Hallo
einfach mal ein paar Ansätze:
- alle Variablen sauber deklarieren mit dem richtigen Variablentyp
- Arrays verwenden
du kopierst viele Werte aus nem Excelsheet in die Userform. Der Zugriff aufs Excelsheet ist relativ langsam, schneller gehts, wenn du die Daten vorab in ein Array kopierst und dann die Daten von da in die Userfoms schreibst.
Beispiel:

Dim arrDaten
arrDaten = range(.cells(RowNr,1), .cells(RowNr,25)).value
tboNachname = arrDaten(1,2)
tboVorname = arrDaten(1,3)
lblAlterHeute = Format(arrDaten(1,25), "yy")

- in die Datenbank gleich die vollen Werte reinschreiben, wenn in der Tabelle schon "Silber" drinsteht, mußt du nicht erst "S" durch "Silber" ersetzten
- Verwenden von SELCET CASE anstelle von If-THEN-ELSE IF
die Bedingungsabfrage mit SELECT CASE ist angeblich effizienter als die mit IF-Then, also

select case UCase(arrDaten(1,10))
case "BS"
obuBS = true
case "SAZ"
obuSAT = true
case "FWDL"
obuFWDL = true
case "GWDL"
obGWDL = true
case else
obuBS = False
obuSAZ = False
obuFWDL = False
obuGWDL = False
end select

anstelle von 

If UCase(.Cells(RowNR, 10)) = "BS" Then
obuBS = True
ElseIf UCase(.Cells(RowNR, 10)) = "SAZ" Then
obuSAZ = True
ElseIf UCase(.Cells(RowNR, 10)) = "FWDL" Then
obuFWDL = True
ElseIf UCase(.Cells(RowNR, 10)) = "GWDL" Then
obuGWDL = True
Else
obuBS = False
obuSAZ = False
obuFWDL = False
obuGWDL = False
End If

- IF-Abfragen wenn möglich vermeiden, anstelle von

If UCase(.Cells(RowNR, 7)) = "M" Then
obuMännlich = True
ElseIf UCase(.Cells(RowNR, 7)) = "W" Then
obuWeiblich = True
Else
obuMännlich = False
obuWeiblich = False
End If

kannst du auch einfacher schreiben:

obuMännlich = UCase(.Cells(RowNR, 7)) = "M"
obuWeiblich = UCase(.Cells(RowNR, 7)) = "W"

Gruß, Daniel
ps, ich lass mal offen für weitere Vorschläge
Anzeige
AW: Makro läuft zu langsam
10.12.2006 14:08:57
Dieterlem
Hallo Daniel,
das mit den Arrays habe ich an einer Beispielsmappe gleich mal getestet. Mit diesem Thema werde ich mich gleich mal beschäftigen.
Das select Case schneller als If - Then Anweisungen sind wußte ich nicht. Das werde ich dann auch ändern.
Diese Art einem OptionButton einen Wert zuweisen war mir auch neu:
obuMännlich = UCase(.Cells(RowNR, 7)) = "M"
Vielen Dank für die Wertvollen Tipps. Ich denke das hat mich wieder ein Stück weiter gebracht.
Gruß
Dieterlem
Prima ... und zu ...
10.12.2006 18:31:25
Schliesser
.
AW: Makro läuft zu langsam
10.12.2006 19:34:14
Dieterlem
Hallo Daniel,
ich habe Deine Tipps nun bei mir eingebaut. Jetzt läuft das Makro um ca ein Drittel schneller.
Ich wünsch Dir noch einen schönen Sonntag Abend.
Gruß Dieterlem
Anzeige
AW: Makro läuft zu langsam
10.12.2006 20:50:37
Daniel
noch ein Tipp
dieses kannst du auch vereinfachen, vorausgesetzt, in der Tabelle ist die entsprechende Spalte bereits richtig formatiert
tboM1Z = Format(.Cells(RowNR, 14), "h:mm") (so nicht)
tboM1Z =.Cells(RowNR, 14).text (so besser)
mit der Cells.text wird der Zellwert so übertragen, wie er auch in der Tabelle sichtbar ist. Damit kannst du dir die Format-Funktion sparen.
Ansonsten würde ich, wie mein Vorgänger schon gesagt hat, das ganze mal nach unnötigen Aktionen durchforsten.
Wenn ein Zellwert nur einmal benötigt wird, ist es nicht notwendig ihn erst in eine Variable zu speichern, das macht erst sinn, wenn er mehrfach verwendet wird.
Desweiteren würde ich mir überlegen, ob so Sachen wie Männlich/Weiblich oder das mit dem Dienstverhältnis wirklich als Option-Button angezeigt werden soll oder ob hier nicht einfach der Wert in eine Textbox reingeschrieben werden kann.
gruß, Daniel
Anzeige

Links zu Excel-Dialogen

TextBox UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige