Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1440to1444
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
1440to1444
1440to1444
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Userform Code verbessern!

Userform Code verbessern!
08.08.2015 18:49:24
Andi
Hallo,
ich habe eine Userform mit 24 TextBoxen, in de ersten Spalte prüfe ich ob die Zelle der erste eines Monats ist, dann soll die ganze Zeile bis Spalte X eine fette Schriftart haben.
Das ganze funktioniert auch, aber das speichern dauert einfach zu lang.
Kann mann das ganze beschleunigen oder optimieren also den Code kürzer schreiben.
Im Augenblick sieht das ganze so aus:
Währe für eine Lösung dankbar.
Gruß
Andi
Private Sub CommandButton3_Click()
Dim lZeile As Long
Dim i As Integer
Application.DisplayAlerts = False
If ListBox1.ListIndex = -1 Then Exit Sub
If Trim(CStr(TextBox1.Text)) = "" Then
Exit Sub
End If
lZeile = 4
Do While Trim(CStr(Tabelle20.Cells(lZeile, 1).Value))  ""
If ListBox1.Text = Trim(CStr(Tabelle20.Cells(lZeile, 1).Value)) Then
If IsDate(TextBox1.Text) Then .Cells(lZeile, 1).Value = Trim(CDate(TextBox1. _
Text))
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 1).Font.Bold =  _
True
If IsNumeric(TextBox2.Text) Then .Cells(lZeile, 2).Value = CDbl(TextBox2.Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 2).Font.Bold =  _
True
TextBox3.Value = .Cells(lZeile, 2).Value - .Cells(lZeile - 1, 2).Value
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 3).Font.Bold =  _
True
If IsNumeric(TextBox3.Text) Then .Cells(lZeile, 3).Value = CDbl(TextBox3.Text)
.Cells(lZeile, 4).Value = Format(TextBox4.Text, "0 °C")
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 4).Font.Bold =  _
True
If IsNumeric(TextBox5.Text) Then .Cells(lZeile, 5).Value = CDbl(TextBox5.Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 5).Font.Bold =  _
True
TextBox6.Value = .Cells(lZeile, 5).Value - .Cells(lZeile - 1, 5).Value
If IsNumeric(TextBox6.Text) Then .Cells(lZeile, 6).Value = CDbl(TextBox6.Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 6).Font.Bold =  _
True
.Cells(lZeile, 7).Value = Format(TextBox7.Text, "0 °C")
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 7).Font.Bold = True
If IsNumeric(TextBox8.Text) Then .Cells(lZeile, 8).Value = CDbl(TextBox8.Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 8).Font.Bold =  _
True
TextBox9.Value = .Cells(lZeile, 8).Value - .Cells(lZeile - 1, 8).Value
If IsNumeric(TextBox9.Text) Then .Cells(lZeile, 9).Value = CDbl(TextBox9.Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 9).Font.Bold =  _
True
.Cells(lZeile, 10).Value = Format(TextBox10.Text, "0 °C")
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 10).Font.Bold =  _
True
If IsNumeric(TextBox11.Text) Then .Cells(lZeile, 11).Value = CDbl(TextBox11. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 11).Font.Bold =  _
True
TextBox12.Value = .Cells(lZeile, 11).Value - .Cells(lZeile - 1, 11).Value
If IsNumeric(TextBox12.Text) Then .Cells(lZeile, 12).Value = CDbl(TextBox12. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 12).Font.Bold =  _
True
.Cells(lZeile, 13).Value = Format(TextBox13.Text, "0 °C")
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 13).Font.Bold =  _
True
If IsNumeric(TextBox14.Text) Then .Cells(lZeile, 14).Value = CDbl(TextBox14. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 14).Font.Bold =  _
True
TextBox15.Value = .Cells(lZeile, 14).Value - .Cells(lZeile - 1, 14).Value
If IsNumeric(TextBox15.Text) Then .Cells(lZeile, 15).Value = CDbl(TextBox15. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 15).Font.Bold =  _
True
.Cells(lZeile, 16).Value = Format(TextBox16.Text, "0 °C")
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 16).Font.Bold =  _
True
If IsNumeric(TextBox17.Text) Then .Cells(lZeile, 17).Value = CDbl(TextBox17. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 17).Font.Bold =  _
True
TextBox18.Value = .Cells(lZeile, 17).Value - .Cells(lZeile - 1, 17).Value
If IsNumeric(TextBox18.Text) Then .Cells(lZeile, 18).Value = CDbl(TextBox18. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 18).Font.Bold =  _
True
.Cells(lZeile, 19).Value = Format(TextBox19.Text, "0 °C")
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 19).Font.Bold =  _
True
If IsNumeric(TextBox20.Text) Then .Cells(lZeile, 20).Value = CDbl(TextBox20. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 20).Font.Bold =  _
True
If IsNumeric(TextBox21.Text) Then .Cells(lZeile, 21).Value = CDbl(TextBox21. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 21).Font.Bold =  _
True
TextBox22.Value = .Cells(lZeile, 21).Value - .Cells(lZeile - 1, 21).Value
If IsNumeric(TextBox22.Text) Then .Cells(lZeile, 22).Value = TextBox22.Text
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 22).Font.Bold =  _
True
.Cells(lZeile, 23).Value = Format(TextBox23.Text, "0 °C")
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 23).Font.Bold =  _
True
If IsNumeric(TextBox24.Text) Then .Cells(lZeile, 24).Value = CDbl(TextBox24. _
Text)
If pruefung_Monatserster(TextBox1.Text) Then .Cells(lZeile, 24).Font.Bold =  _
True
End With
If ListBox1.Text  Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
Fehler:
Application.DisplayAlerts = True
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Userform Code verbessern!
09.08.2015 09:10:57
Sepp
Hallo Andi,
du prüfst ja auch 24 mal die selbe Bedingung, man kann doch einfach ein Mal Prüfen und die ganze Zeile Fett formatieren.
Private Sub CommandButton3_Click()
Dim lZeile As Long
Dim i As Integer
Application.DisplayAlerts = False

If ListBox1.ListIndex = -1 Then Exit Sub

If Trim(CStr(TextBox1.Text)) = "" Then
  
  Exit Sub
End If

lZeile = 4
With Tabelle20
  Do While Trim(CStr(.Cells(lZeile, 1).Value)) <> ""
    If ListBox1.Text = Trim(CStr(.Cells(lZeile, 1).Value)) Then
      
      .Rows(lZeile).Font.Bold = pruefung_Monatserster(TextBox1.Text)
      
      If IsDate(TextBox1.Text) Then .Cells(lZeile, 1).Value = Trim(CDate(TextBox1.Text))
      
      If IsNumeric(TextBox2.Text) Then .Cells(lZeile, 2).Value = CDbl(TextBox2.Text)
      
      TextBox3.Value = .Cells(lZeile, 2).Value - .Cells(lZeile - 1, 2).Value
      
      If IsNumeric(TextBox3.Text) Then .Cells(lZeile, 3).Value = CDbl(TextBox3.Text)
      
      .Cells(lZeile, 4).Value = Format(TextBox4.Text, "0 °C")
      
      If IsNumeric(TextBox5.Text) Then .Cells(lZeile, 5).Value = CDbl(TextBox5.Text)
      
      TextBox6.Value = .Cells(lZeile, 5).Value - .Cells(lZeile - 1, 5).Value
      
      If IsNumeric(TextBox6.Text) Then .Cells(lZeile, 6).Value = CDbl(TextBox6.Text)
      
      .Cells(lZeile, 7).Value = Format(TextBox7.Text, "0 °C")
      
      If IsNumeric(TextBox8.Text) Then .Cells(lZeile, 8).Value = CDbl(TextBox8.Text)
      
      TextBox9.Value = .Cells(lZeile, 8).Value - .Cells(lZeile - 1, 8).Value
      
      If IsNumeric(TextBox9.Text) Then .Cells(lZeile, 9).Value = CDbl(TextBox9.Text)
      
      .Cells(lZeile, 10).Value = Format(TextBox10.Text, "0 °C")
      
      If IsNumeric(TextBox11.Text) Then .Cells(lZeile, 11).Value = CDbl(TextBox11.Text)
      
      TextBox12.Value = .Cells(lZeile, 11).Value - .Cells(lZeile - 1, 11).Value
      
      If IsNumeric(TextBox12.Text) Then .Cells(lZeile, 12).Value = CDbl(TextBox12.Text)
      
      .Cells(lZeile, 13).Value = Format(TextBox13.Text, "0 °C")
      
      If IsNumeric(TextBox14.Text) Then .Cells(lZeile, 14).Value = CDbl(TextBox14.Text)
      
      TextBox15.Value = .Cells(lZeile, 14).Value - .Cells(lZeile - 1, 14).Value
      
      If IsNumeric(TextBox15.Text) Then .Cells(lZeile, 15).Value = CDbl(TextBox15.Text)
      
      .Cells(lZeile, 16).Value = Format(TextBox16.Text, "0 °C")
      
      If IsNumeric(TextBox17.Text) Then .Cells(lZeile, 17).Value = CDbl(TextBox17.Text)
      
      TextBox18.Value = .Cells(lZeile, 17).Value - .Cells(lZeile - 1, 17).Value
      
      If IsNumeric(TextBox18.Text) Then .Cells(lZeile, 18).Value = CDbl(TextBox18.Text)
      
      .Cells(lZeile, 19).Value = Format(TextBox19.Text, "0 °C")
      
      If IsNumeric(TextBox20.Text) Then .Cells(lZeile, 20).Value = CDbl(TextBox20.Text)
      
      If IsNumeric(TextBox21.Text) Then .Cells(lZeile, 21).Value = CDbl(TextBox21.Text)
      
      TextBox22.Value = .Cells(lZeile, 21).Value - .Cells(lZeile - 1, 21).Value
      
      If IsNumeric(TextBox22.Text) Then .Cells(lZeile, 22).Value = TextBox22.Text
      
      .Cells(lZeile, 23).Value = Format(TextBox23.Text, "0 °C")
      
      If IsNumeric(TextBox24.Text) Then .Cells(lZeile, 24).Value = CDbl(TextBox24.Text)
      
      If ListBox1.Text <> Trim(CStr(TextBox1.Text)) Then
        Call UserForm_Initialize
        If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
      End If
      Exit Do
    End If
    lZeile = lZeile + 1 'Nächste Zeile bearbeiten
  Loop
End With
Fehler:
Application.DisplayAlerts = True
End Sub



Gruß Sepp

Anzeige
und ausserdem
09.08.2015 09:16:38
Sepp
ist deine Fehlerbehandlung unvollständig und man sollte die Events und die Berechnung ausschalten.
Private Sub CommandButton3_Click()
Dim lZeile As Long
Dim i As Integer

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlManual
  .DisplayAlerts = False
End With

If ListBox1.ListIndex = -1 Then GoTo ErrExit

If Trim(CStr(TextBox1.Text)) = "" Then
  
  Exit Sub
End If

lZeile = 4
With Tabelle20
  Do While Trim(CStr(.Cells(lZeile, 1).Value)) <> ""
    If ListBox1.Text = Trim(CStr(.Cells(lZeile, 1).Value)) Then
      
      .Rows(lZeile).Font.Bold = pruefung_Monatserster(TextBox1.Text)
      
      If IsDate(TextBox1.Text) Then .Cells(lZeile, 1).Value = Trim(CDate(TextBox1.Text))
      
      If IsNumeric(TextBox2.Text) Then .Cells(lZeile, 2).Value = CDbl(TextBox2.Text)
      
      TextBox3.Value = .Cells(lZeile, 2).Value - .Cells(lZeile - 1, 2).Value
      
      If IsNumeric(TextBox3.Text) Then .Cells(lZeile, 3).Value = CDbl(TextBox3.Text)
      
      .Cells(lZeile, 4).Value = Format(TextBox4.Text, "0 °C")
      
      If IsNumeric(TextBox5.Text) Then .Cells(lZeile, 5).Value = CDbl(TextBox5.Text)
      
      TextBox6.Value = .Cells(lZeile, 5).Value - .Cells(lZeile - 1, 5).Value
      
      If IsNumeric(TextBox6.Text) Then .Cells(lZeile, 6).Value = CDbl(TextBox6.Text)
      
      .Cells(lZeile, 7).Value = Format(TextBox7.Text, "0 °C")
      
      If IsNumeric(TextBox8.Text) Then .Cells(lZeile, 8).Value = CDbl(TextBox8.Text)
      
      TextBox9.Value = .Cells(lZeile, 8).Value - .Cells(lZeile - 1, 8).Value
      
      If IsNumeric(TextBox9.Text) Then .Cells(lZeile, 9).Value = CDbl(TextBox9.Text)
      
      .Cells(lZeile, 10).Value = Format(TextBox10.Text, "0 °C")
      
      If IsNumeric(TextBox11.Text) Then .Cells(lZeile, 11).Value = CDbl(TextBox11.Text)
      
      TextBox12.Value = .Cells(lZeile, 11).Value - .Cells(lZeile - 1, 11).Value
      
      If IsNumeric(TextBox12.Text) Then .Cells(lZeile, 12).Value = CDbl(TextBox12.Text)
      
      .Cells(lZeile, 13).Value = Format(TextBox13.Text, "0 °C")
      
      If IsNumeric(TextBox14.Text) Then .Cells(lZeile, 14).Value = CDbl(TextBox14.Text)
      
      TextBox15.Value = .Cells(lZeile, 14).Value - .Cells(lZeile - 1, 14).Value
      
      If IsNumeric(TextBox15.Text) Then .Cells(lZeile, 15).Value = CDbl(TextBox15.Text)
      
      .Cells(lZeile, 16).Value = Format(TextBox16.Text, "0 °C")
      
      If IsNumeric(TextBox17.Text) Then .Cells(lZeile, 17).Value = CDbl(TextBox17.Text)
      
      TextBox18.Value = .Cells(lZeile, 17).Value - .Cells(lZeile - 1, 17).Value
      
      If IsNumeric(TextBox18.Text) Then .Cells(lZeile, 18).Value = CDbl(TextBox18.Text)
      
      .Cells(lZeile, 19).Value = Format(TextBox19.Text, "0 °C")
      
      If IsNumeric(TextBox20.Text) Then .Cells(lZeile, 20).Value = CDbl(TextBox20.Text)
      
      If IsNumeric(TextBox21.Text) Then .Cells(lZeile, 21).Value = CDbl(TextBox21.Text)
      
      TextBox22.Value = .Cells(lZeile, 21).Value - .Cells(lZeile - 1, 21).Value
      
      If IsNumeric(TextBox22.Text) Then .Cells(lZeile, 22).Value = TextBox22.Text
      
      .Cells(lZeile, 23).Value = Format(TextBox23.Text, "0 °C")
      
      If IsNumeric(TextBox24.Text) Then .Cells(lZeile, 24).Value = CDbl(TextBox24.Text)
      
      If ListBox1.Text <> Trim(CStr(TextBox1.Text)) Then
        Call UserForm_Initialize
        If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
      End If
      Exit Do
    End If
    lZeile = lZeile + 1 'Nächste Zeile bearbeiten
  Loop
End With

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'CommandButton3_Click'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - CommandButton3_Click"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlAutomatic
  .DisplayAlerts = True
  .StatusBar = False
End With

End Sub



Gruß Sepp

Anzeige
noch mal verkürzt
09.08.2015 09:33:03
Sepp 
Private Sub CommandButton3_Click()
Dim lZeile As Long
Dim i As Integer

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlManual
  .DisplayAlerts = False
End With

If ListBox1.ListIndex > -1 And Trim(TextBox1.Text) <> "" Then
  lZeile = 4
  With Tabelle20
    Do While Trim(CStr(.Cells(lZeile, 1).Value)) <> ""
      If ListBox1.Text = Trim(CStr(.Cells(lZeile, 1).Value)) Then
        
        .Rows(lZeile).Font.Bold = Day(CDate(TextBox1.Text)) = 1
        
        If IsDate(TextBox1.Text) Then .Cells(lZeile, 1).Value = Trim(CDate(TextBox1.Text))
        
        If IsNumeric(TextBox2.Text) Then .Cells(lZeile, 2).Value = CDbl(TextBox2.Text)
        
        TextBox3.Value = .Cells(lZeile, 2).Value - .Cells(lZeile - 1, 2).Value
        
        If IsNumeric(TextBox3.Text) Then .Cells(lZeile, 3).Value = CDbl(TextBox3.Text)
        
        .Cells(lZeile, 4).Value = Format(TextBox4.Text, "0 °C")
        
        If IsNumeric(TextBox5.Text) Then .Cells(lZeile, 5).Value = CDbl(TextBox5.Text)
        
        TextBox6.Value = .Cells(lZeile, 5).Value - .Cells(lZeile - 1, 5).Value
        
        If IsNumeric(TextBox6.Text) Then .Cells(lZeile, 6).Value = CDbl(TextBox6.Text)
        
        .Cells(lZeile, 7).Value = Format(TextBox7.Text, "0 °C")
        
        If IsNumeric(TextBox8.Text) Then .Cells(lZeile, 8).Value = CDbl(TextBox8.Text)
        
        TextBox9.Value = .Cells(lZeile, 8).Value - .Cells(lZeile - 1, 8).Value
        
        If IsNumeric(TextBox9.Text) Then .Cells(lZeile, 9).Value = CDbl(TextBox9.Text)
        
        .Cells(lZeile, 10).Value = Format(TextBox10.Text, "0 °C")
        
        If IsNumeric(TextBox11.Text) Then .Cells(lZeile, 11).Value = CDbl(TextBox11.Text)
        
        TextBox12.Value = .Cells(lZeile, 11).Value - .Cells(lZeile - 1, 11).Value
        
        If IsNumeric(TextBox12.Text) Then .Cells(lZeile, 12).Value = CDbl(TextBox12.Text)
        
        .Cells(lZeile, 13).Value = Format(TextBox13.Text, "0 °C")
        
        If IsNumeric(TextBox14.Text) Then .Cells(lZeile, 14).Value = CDbl(TextBox14.Text)
        
        TextBox15.Value = .Cells(lZeile, 14).Value - .Cells(lZeile - 1, 14).Value
        
        If IsNumeric(TextBox15.Text) Then .Cells(lZeile, 15).Value = CDbl(TextBox15.Text)
        
        .Cells(lZeile, 16).Value = Format(TextBox16.Text, "0 °C")
        
        If IsNumeric(TextBox17.Text) Then .Cells(lZeile, 17).Value = CDbl(TextBox17.Text)
        
        TextBox18.Value = .Cells(lZeile, 17).Value - .Cells(lZeile - 1, 17).Value
        
        If IsNumeric(TextBox18.Text) Then .Cells(lZeile, 18).Value = CDbl(TextBox18.Text)
        
        .Cells(lZeile, 19).Value = Format(TextBox19.Text, "0 °C")
        
        If IsNumeric(TextBox20.Text) Then .Cells(lZeile, 20).Value = CDbl(TextBox20.Text)
        
        If IsNumeric(TextBox21.Text) Then .Cells(lZeile, 21).Value = CDbl(TextBox21.Text)
        
        TextBox22.Value = .Cells(lZeile, 21).Value - .Cells(lZeile - 1, 21).Value
        
        If IsNumeric(TextBox22.Text) Then .Cells(lZeile, 22).Value = TextBox22.Text
        
        .Cells(lZeile, 23).Value = Format(TextBox23.Text, "0 °C")
        
        If IsNumeric(TextBox24.Text) Then .Cells(lZeile, 24).Value = CDbl(TextBox24.Text)
        
        If ListBox1.Text <> Trim(CStr(TextBox1.Text)) Then
          Call UserForm_Initialize
          If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
        End If
        Exit Do
      End If
      lZeile = lZeile + 1 'Nächste Zeile bearbeiten
    Loop
  End With
End If

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'CommandButton3_Click'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - CommandButton3_Click"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlAutomatic
  .DisplayAlerts = True
  .StatusBar = False
End With

End Sub


Gruß Sepp

Anzeige
AW: Userform Code verbessern!
09.08.2015 13:30:34
Gerd
Hallo Andi,
zum Teil ist noch eine Regelmäßigkeit drin.
Private Sub CommandButton3_Click()
Dim lZeile As Long
Dim i As Long
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
.DisplayAlerts = False
End With
If ListBox1.ListIndex > -1 And Trim(TextBox1.Text)  "" Then
lZeile = 4
With Tabelle20
Do While Trim(CStr(.Cells(lZeile, 1).Value))  ""
If ListBox1.Text = Trim(CStr(.Cells(lZeile, 1).Value)) Then
.Rows(lZeile).Font.Bold = Day(CDate(TextBox1.Text)) = 1
If IsDate(TextBox1.Text) Then .Cells(lZeile, 1).Value = Trim(CDate(TextBox1.Text))
For i = 2 To 17 Step 3
If IsNumeric(Controls("TextBox" & i).Text) Then .Cells(lZeile, i).Value = CDbl(Conrols(" _
TextBox" & i).Text)
Controls("TextBox" & i + 1).Value = .Cells(lZeile, i).Value - .Cells(lZeile - 1, i). _
Value
If IsNumeric(Controls("TextBox" & i + 1)) Then .Cells(lZeile, i + 1).Value = CDbl( _
Controls("TextBox" & i + 1).Text)
.Cells(lZeile, i + 2).Value = Format(Controls("TextBox" & i + 2).Text, "0 °C")
Next
If IsNumeric(TextBox20.Text) Then .Cells(lZeile, 20).Value = CDbl(TextBox20.Text)
If IsNumeric(TextBox21.Text) Then .Cells(lZeile, 21).Value = CDbl(TextBox21.Text)
TextBox22.Value = .Cells(lZeile, 21).Value - .Cells(lZeile - 1, 21).Value
If IsNumeric(TextBox22.Text) Then .Cells(lZeile, 22).Value = TextBox22.Text
.Cells(lZeile, 23).Value = Format(TextBox23.Text, "0 °C")
If IsNumeric(TextBox24.Text) Then .Cells(lZeile, 24).Value = CDbl(TextBox24.Text)
If ListBox1.Text  Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End With
End If
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'CommandButton3_Click'" & vbLf & String(60, "_") &  _
_
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - CommandButton3_Click"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
.DisplayAlerts = True
.StatusBar = False
End With
End Sub
Gruß Gerd

Anzeige
Vielen Dank!!
09.08.2015 17:30:52
Andi
Hallo,
habe es eingefügt, klappt wunderbar von Sepp.
Viel schneller wie vorher!!
Gerd bei deiner Lösung bekomme ich eine Fehlermeldung. Sub oder Function nicht definiert.
If IsNumeric(Controls("TextBox" & i).Text) Then .Cells(lZeile, i).Value = CDbl(Conrols("TextBox " & i).Text)
Controls("TextBox" & i + 1).Value = .Cells(lZeile, i).Value - .Cells(lZeile - 1, i). _
Value
Danke
Andi

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