Clever-Excel-Forum › Office-Anwendungen › Excel v
Userform flackert, wenn OptionButton / Checkbox / Grösse UF geändert werden

Thema geschlossen 
Baumstrukturmodus
Userform flackert, wenn OptionButton / Checkbox / Grösse UF geändert werden
Lopezoli Offline
pausiert
Registriert seit: 17.12.2018
Version(en): Office Professional Plus 2016
#1
04.06.2019, 08:57
Morgen

Ich hab ein Problem, welches mehrere Userformen betrifft. Über OptionButtons in diesen können Baugruppen dargestellt werden um KOmponenten anzuzeigen / auszuwählen. Mit Checkboxen werden zusätzlich optionale Artikel der Userform hinzugefügt, so dass sich diese in der Grösse ändert. Nun ist es so, dass beim Betätigen der Optionbuttons resp. Checkboxen die Userform kurz aufflackern (siehe Video)



Application.ScreenUpdating = True / False hab ich schon im Code drin:

Code:
Option Explicit

Dim traverse() As String
Dim hakenschraube() As String
Dim stabiso As String
Dim wiege As String
Dim gabellasche As String

Dim search_traverse() As String
Dim search_hakenschraube As String
Dim search_stabiso As String
Dim search_wiege As String
Dim search_gabellasche As String

Dim size_traverse As Integer
Dim size_hakenschraube As Integer

Dim filter_list() As String
Dim artikel_und_menge(0 To 5, 0 To 1)
Dim num_komp_minus1 As Integer
Dim komp_count As Integer
Dim search_filter As String
---------------------------------------------------------
Sub CheckBox1_Change()
Application.ScreenUpdating = False
If UserForm_TS1.OptionButton1.Value = True Then
   UserForm_TS1.OptionButton1.Value = False
   UserForm_TS1.OptionButton1.Value = True
ElseIf UserForm_TS1.OptionButton2.Value = True Then
   UserForm_TS1.OptionButton2.Value = False
   UserForm_TS1.OptionButton2.Value = True
ElseIf UserForm_TS1.OptionButton3.Value = True Then
   UserForm_TS1.OptionButton3.Value = False
   UserForm_TS1.OptionButton3.Value = True
ElseIf UserForm_TS1.OptionButton4.Value = True Then
   UserForm_TS1.OptionButton4.Value = False
   UserForm_TS1.OptionButton4.Value = True
End If
Application.ScreenUpdating = True
End Sub
------------------------------------------------------------
Sub ComboBox1_Change()

artikel_und_menge(0, 0) = UserForm_TS1.ComboBox1.Value
If ToggleButton_Check.Value = True Then
   filter_list(0) = UserForm_TS1.ComboBox1.Value
   ActiveSheet.Range("D:D").AutoFilter 4, filter_list, xlFilterValues
End If

End Sub
Sub ComboBox2_Change()

artikel_und_menge(1, 0) = UserForm_TS1.ComboBox2.Value
If ToggleButton_Check.Value = True Then
   filter_list(1) = UserForm_TS1.ComboBox2.Value
   ActiveSheet.Range("D:D").AutoFilter 4, filter_list, xlFilterValues
End If

End Sub
-------------------------------------------------------------
Sub UserForm_Initialize()

UserForm_TS1.Caption = "Baugruppe " & UserForm_Module.ComboBox1.Value & " ausgewählt"                     'Caption der Userform wird gefüllt

If ActiveSheet.AutoFilterMode = True Then                                                                   'Filter wird zurückgesetzt, wenn vorher einer aktiv war
   search_filter = "*" & UserForm_Module.ComboBox1.Value & "*"
   ActiveSheet.Range("A2;D1000").AutoFilter last_qp, search_filter
   ActiveSheet.ShowAllData
   ActiveSheet.Range("A2;D1000").AutoFilter last_qp, search_filter
End If

Dim typ(0 To 4)
   typ(0) = "an Ausleger"
   typ(1) = "an Joch"
   typ(2) = "an Typ III"
   typ(3) = "Hänge-Isolation"
   typ(4) = "+ 2. Tragseil"
UserForm_TS1.OptionButton1.Caption = typ(0)
UserForm_TS1.OptionButton2.Caption = typ(1)
UserForm_TS1.OptionButton3.Caption = typ(2)
UserForm_TS1.OptionButton4.Caption = typ(3)
UserForm_TS1.CheckBox1.Caption = typ(4)

'Array für Artikel nach Baugruppen-auswahl1 inkl. Menge OHNE Combobox-Artikel
artikel_und_menge(0, 0) = "Für Traverse"
artikel_und_menge(0, 1) = 1
artikel_und_menge(1, 0) = "Für Stabiso/Hakenschraube"
artikel_und_menge(1, 1) = 1
artikel_und_menge(2, 0) = "Für Hängewiege/Stabiso"
artikel_und_menge(2, 1) = 1
artikel_und_menge(3, 0) = "Für Hängewiege/Gabellasche"
artikel_und_menge(3, 1) = 1
artikel_und_menge(4, 0) = "Für Gabellasche"
artikel_und_menge(4, 1) = 1
artikel_und_menge(5, 0) = "Für Pendelwiege"
artikel_und_menge(5, 1) = 1

Dim finden_init As Range                                                                                    'Durchsucht Spalte 4 nach Suchbegriff
Dim treffer_init As String

'Suche Traverse
ReDim search_traverse(0 To 3)
   search_traverse(0) = "Traverse*für*Hängeisolation*Ausleger*kpl*"
   search_traverse(1) = "Traverse*für*Hängeisolation*J*mm*"
   search_traverse(2) = "Traverse*für*Hängeisolation*Ausleger*III*"
   search_traverse(3) = "Traverse*für*Hängeisolation*UNP2*"
   
Dim a As Integer                                                                                  'Wo wurde der Begriff gefunden? Angabe der Zelle                                                                                        'Array speichert Addressen
size_traverse = 0
For a = 0 To 3
   Set finden_init = Columns(4).Find(what:=search_traverse(a))                                                    'Sucht nach "Tagjoch"-Zellen für Ausfüllen/Entfernen
       If Not finden_init Is Nothing Then
           treffer_init = finden_init.Address
           Do
           ReDim Preserve traverse(0, size_traverse)
           traverse(0, size_traverse) = finden_init.Value
           Set finden_init = Columns(4).FindNext(finden_init)
           size_traverse = size_traverse + 1
           Loop While Not finden_init Is Nothing And treffer_init <> finden_init.Address
       End If
Next
'Ende Suche Traverse

'Suche Hakenschraube
search_hakenschraube = "Hakenschraube*M16x*mit*Mutter*"
   
Dim b As Integer                                                                                  'Wo wurde der Begriff gefunden? Angabe der Zelle                                                                                        'Array speichert Addressen
size_hakenschraube = 0

Set finden_init = Columns(4).Find(what:=search_hakenschraube)                                                    'Sucht nach "Mast HEB"-Zellen für Ausfüllen/Entfernen
   If Not finden_init Is Nothing Then
       treffer_init = finden_init.Address                                                              'Speichert die erste Adresse
       Do
       ReDim Preserve hakenschraube(0, size_hakenschraube)                                                           'Passt Array-Grösse laufend an
           hakenschraube(0, size_hakenschraube) = finden_init.Value
           size_hakenschraube = size_hakenschraube + 1
       Set finden_init = Columns(4).FindNext(finden_init)
       Loop While Not finden_init Is Nothing And treffer_init <> finden_init.Address
   End If
'Ende Suche Hakenschraube

'Suche Stabisolator
search_stabiso = "Stabisolator*Sefag*"
   
Set finden_init = Range("D:D").Find(what:=search_stabiso)
   If Not finden_init Is Nothing Then
       treffer_init = finden_init.Address
       stabiso = finden_init.Value
   End If
'Ende Suche Stabisolator

'Suche Hängewiege
search_wiege = "Hängewiege*95-150*"
   
Set finden_init = Range("D:D").Find(what:=search_wiege)
   If Not finden_init Is Nothing Then
       treffer_init = finden_init.Address
       wiege = finden_init.Value
   End If
'Ende Suche Hängewiege

'Suche Gabellasche
search_gabellasche = "Gabellasche*für*2*Wiegen*"
   
Set finden_init = Range("D:D").Find(what:=search_gabellasche)
   If Not finden_init Is Nothing Then
       treffer_init = finden_init.Address
       gabellasche = finden_init.Value
   End If
'Ende Suche Gabellasche

With UserForm_TS1
   .Label9.Caption = Join(QP_selected, " | ")
   
   .CommandButton_Add.Font.size = 10
   .CommandButton_Remove.Font.size = 10
   .CommandButton_Back.Font.size = 10
   .CommandButton_Finish.Font.size = 10
   
   .OptionButton1.Value = True
   .CheckBox1.Value = False
   .Height = 435
End With

ToggleButton_Check.Value = True
ToggleButton_Hide.Value = True

End Sub
------------------------------------------------------
Sub OptionButton1_Click()                           'an Ausleger
Application.ScreenUpdating = False
With UserForm_TS1
   .ComboBox1.Visible = False
   .ComboBox2.Visible = False
   
   .Label1.Visible = True
   .Label1.Caption = "  " & traverse(0, 0)
   .Label1.Font.size = 10
   .TextBox1.Value = 1
   .TextBox1.Font.size = 10
   .Label2.Visible = True
   .Label2.Caption = "  " & stabiso
   .Label2.Font.size = 10
   .TextBox2.Value = 1
   .TextBox2.Font.size = 10
   .Label3.Caption = "  " & wiege
   .Label3.Font.size = 10
   .TextBox3.Value = 1
   .TextBox3.Font.size = 10
   
   .Label4.Visible = False
   .TextBox4.Visible = False

   ReDim filter_list(2)
   filter_list(0) = traverse(0, 0)
   filter_list(1) = stabiso
   filter_list(2) = wiege
   
   artikel_und_menge(0, 0) = traverse(0, 0)
   artikel_und_menge(0, 1) = 1
   artikel_und_menge(1, 0) = stabiso
   artikel_und_menge(1, 1) = 1
   artikel_und_menge(2, 0) = wiege
   artikel_und_menge(2, 1) = 1
   
   If .CheckBox1.Value = True Then
       .Height = 465
       num_komp_minus1 = 3
       
       
       .TextBox3.Value = 2
       .Label5.Visible = True
       .Label5.Caption = "  " & gabellasche
       .Label5.Font.size = 10
       .TextBox5.Visible = True
       .TextBox5.Value = 1
       .TextBox5.Font.size = 10
       
       .ToggleButton_Check.Top = 254
       .CommandButton_Add.Top = 254
       .CommandButton_Remove.Top = 254
       .ToggleButton_Hide.Top = 291
       .CommandButton_Back.Top = 291
       .CommandButton_Finish.Top = 291
       .Label00.Top = 328
       
       ReDim Preserve filter_list(3)
       filter_list(3) = gabellasche
       
       artikel_und_menge(2, 1) = 2
       artikel_und_menge(3, 0) = gabellasche
       artikel_und_menge(3, 1) = 1
   ElseIf .CheckBox1.Value = False Then
       .Height = 465
       num_komp_minus1 = 2
       
       .Label5.Visible = False
       .TextBox5.Visible = False
       
       .ToggleButton_Check.Top = 228
       .CommandButton_Add.Top = 228
       .CommandButton_Remove.Top = 228
       .ToggleButton_Hide.Top = 265
       .CommandButton_Back.Top = 265
       .CommandButton_Finish.Top = 265
       .Label00.Top = 302
       
       ReDim Preserve filter_list(2)
   End If
End With

If ToggleButton_Check.Value = True Then
ActiveSheet.Range("D:D").AutoFilter 4, filter_list(), xlFilterValues
End If
Application.ScreenUpdating = True
End Sub
----------------------------------------
Sub OptionButton2_Click()                           'an Joch
Application.ScreenUpdating = False
With UserForm_TS1
   Do While ComboBox1.ListCount > 0
       ComboBox1.RemoveItem (0)
   Loop
   Do While ComboBox2.ListCount > 0
       ComboBox2.RemoveItem (0)
   Loop
   
   'Oberfläche
   Dim auswahl1 As Integer
   For auswahl1 = 1 To 2
       .ComboBox1.AddItem traverse(0, auswahl1)
   Next
   .ComboBox1.Font.size = 10
   ComboBox1.ListIndex = 0
   
   Dim auswahl2 As Integer
   For auswahl2 = 0 To 3
       .ComboBox2.AddItem hakenschraube(0, auswahl2)
   Next
   .ComboBox2.Font.size = 10
   .ComboBox2.ListIndex = 0
   
   .ComboBox1.Visible = True
   .ComboBox2.Visible = True
   
   .Label1.Visible = False
   .TextBox1.Value = 1
   .TextBox1.Font.size = 10
   .Label2.Visible = False
   .TextBox2.Value = 2
   .TextBox2.Font.size = 10
   .Label3.Caption = "  " & stabiso
   .Label3.Font.size = 10
   .TextBox3.Value = 1
   .TextBox3.Font.size = 10
   .Label4.Visible = True
   .Label4.Caption = "  " & wiege
   .Label4.Font.size = 10
   .TextBox4.Visible = True
   .TextBox4.Value = 1
   .TextBox4.Font.size = 10
   
   ReDim filter_list(3)
   filter_list(0) = traverse(0, 1)
   filter_list(1) = hakenschraube(0, 0)
   filter_list(2) = stabiso
   filter_list(3) = wiege
   
   artikel_und_menge(0, 0) = traverse(0, 1)
   artikel_und_menge(0, 1) = 1
   artikel_und_menge(1, 0) = hakenschraube(0, 0)
   artikel_und_menge(1, 1) = 2
   artikel_und_menge(2, 0) = stabiso
   artikel_und_menge(2, 1) = 1
   artikel_und_menge(3, 0) = wiege
   artikel_und_menge(3, 1) = 1
   
   If .CheckBox1.Value = True Then
       num_komp_minus1 = 4
       
       .TextBox4.Value = 2
       .Label5.Visible = True
       .Label5.Caption = "  " & gabellasche
       .Label5.Font.size = 10
       .TextBox5.Visible = True
       .TextBox5.Value = 1
       .TextBox5.Font.size = 10
       
       .ToggleButton_Check.Top = 254
       .CommandButton_Add.Top = 254
       .CommandButton_Remove.Top = 254
       .ToggleButton_Hide.Top = 291
       .CommandButton_Back.Top = 291
       .CommandButton_Finish.Top = 291
       .Label00.Top = 328
       
       .Height = 465
       
       ReDim Preserve filter_list(4)
       filter_list(4) = gabellasche
       
       artikel_und_menge(1, 1) = 2
       artikel_und_menge(4, 0) = gabellasche
       artikel_und_menge(4, 1) = 1
       
   ElseIf .CheckBox1.Value = False Then
       num_komp_minus1 = 3
       
       .Label5.Visible = False
       .TextBox5.Visible = False
       
       .ToggleButton_Check.Top = 228
       .CommandButton_Add.Top = 228
       .CommandButton_Remove.Top = 228
       .ToggleButton_Hide.Top = 265
       .CommandButton_Back.Top = 265
       .CommandButton_Finish.Top = 265
       .Label00.Top = 302
       
       .Height = 435
       
       ReDim Preserve filter_list(3)
   End If
   
End With

filter_list(0) = UserForm_TS1.ComboBox1.Value
filter_list(1) = UserForm_TS1.ComboBox2.Value

If ToggleButton_Check.Value = True Then
   ActiveSheet.Range("D:D").AutoFilter 4, filter_list(), xlFilterValues
End If
Application.ScreenUpdating = True
End Sub
-------------------------------------------------
Sub OptionButton3_Click()                           'an Typ III
Application.ScreenUpdating = False
With UserForm_TS1
   .ComboBox1.Visible = False
   .ComboBox2.Visible = False
   
   .Label1.Visible = True
   .Label1.Caption = "  " & traverse(0, 4)
   .Label1.Font.size = 10
   .TextBox1.Value = 1
   .TextBox1.Font.size = 10
   .Label2.Visible = True
   .Label2.Caption = "  " & stabiso
   .Label2.Font.size = 10
   .TextBox2.Value = 1
   .TextBox2.Font.size = 10
   .Label3.Caption = "  " & wiege
   .Label3.Font.size = 10
   .TextBox3.Value = 1
   .TextBox3.Font.size = 10
   
   .Label4.Visible = False
   .TextBox4.Visible = False

   ReDim filter_list(2)
   filter_list(0) = traverse(0, 4)
   filter_list(1) = stabiso
   filter_list(2) = wiege
   
   artikel_und_menge(0, 0) = traverse(0, 4)
   artikel_und_menge(0, 1) = 1
   artikel_und_menge(1, 0) = stabiso
   artikel_und_menge(1, 1) = 1
   artikel_und_menge(2, 0) = wiege
   artikel_und_menge(2, 1) = 1
   
   If .CheckBox1.Value = True Then
       num_komp_minus1 = 3
       
       .TextBox3.Value = 2
       .Label5.Visible = True
       .Label5.Caption = "  " & gabellasche
       .Label5.Font.size = 10
       .TextBox5.Visible = True
       .TextBox5.Value = 1
       .TextBox5.Font.size = 10
       
       .ToggleButton_Check.Top = 254
       .CommandButton_Add.Top = 254
       .CommandButton_Remove.Top = 254
       .ToggleButton_Hide.Top = 291
       .CommandButton_Back.Top = 291
       .CommandButton_Finish.Top = 291
       .Label00.Top = 328
       
       .Height = 465
       
       ReDim Preserve filter_list(3)
       filter_list(3) = gabellasche
       
       artikel_und_menge(2, 1) = 2
       artikel_und_menge(3, 0) = gabellasche
       artikel_und_menge(3, 1) = 1
       
   ElseIf .CheckBox1.Value = False Then
       num_komp_minus1 = 2
       
       .Label5.Visible = False
       .TextBox5.Visible = False
       
       .ToggleButton_Check.Top = 228
       .CommandButton_Add.Top = 228
       .CommandButton_Remove.Top = 228
       .ToggleButton_Hide.Top = 265
       .CommandButton_Back.Top = 265
       .CommandButton_Finish.Top = 265
       .Label00.Top = 302
       
       .Height = 435
       
       ReDim Preserve filter_list(2)
   End If
End With

If ToggleButton_Check.Value = True Then
ActiveSheet.Range("D:D").AutoFilter 4, filter_list(), xlFilterValues
End If
Application.ScreenUpdating = True
End Sub
----------------------------------------------------
Sub OptionButton4_Click()                       'Hänge-Isolation
Application.ScreenUpdating = False
With UserForm_TS1
   Do While ComboBox1.ListCount > 0
       ComboBox1.RemoveItem (0)
   Loop
   Do While ComboBox2.ListCount > 0
       ComboBox2.RemoveItem (0)
   Loop
   
   'Oberfläche
   Dim auswahl1 As Integer
   For auswahl1 = 5 To 7
       .ComboBox1.AddItem traverse(0, auswahl1)
   Next
   .ComboBox1.Font.size = 10
   ComboBox1.ListIndex = 0
   
   .ComboBox1.Visible = True
   .ComboBox2.Visible = False
   
   .Label1.Visible = False
   .TextBox1.Value = 1
   .TextBox1.Font.size = 10
   .Label2.Visible = True
   .Label2.Caption = "  " & stabiso
   .Label2.Font.size = 10
   .TextBox2.Value = 1
   .TextBox2.Font.size = 10
   .Label3.Caption = "  " & wiege
   .Label3.Font.size = 10
   .TextBox3.Value = 1
   .TextBox3.Font.size = 10
   
   .Label4.Visible = False
   .TextBox4.Visible = False

   ReDim filter_list(2)
   filter_list(0) = traverse(0, 5)
   filter_list(1) = stabiso
   filter_list(2) = wiege
   
   artikel_und_menge(0, 0) = traverse(0, 5)
   artikel_und_menge(0, 1) = 1
   artikel_und_menge(1, 0) = stabiso
   artikel_und_menge(1, 1) = 1
   artikel_und_menge(2, 0) = wiege
   artikel_und_menge(2, 1) = 1
   
   If .CheckBox1.Value = True Then
       num_komp_minus1 = 3
       
       .TextBox3.Value = 2
       .Label5.Visible = True
       .Label5.Caption = "  " & gabellasche
       .Label5.Font.size = 10
       .TextBox5.Visible = True
       .TextBox5.Value = 1
       .TextBox5.Font.size = 10
       
       .ToggleButton_Check.Top = 254
       .CommandButton_Add.Top = 254
       .CommandButton_Remove.Top = 254
       .ToggleButton_Hide.Top = 291
       .CommandButton_Back.Top = 291
       .CommandButton_Finish.Top = 291
       .Label00.Top = 328
       
       .Height = 465
       
       ReDim Preserve filter_list(3)
       filter_list(3) = gabellasche
       
       artikel_und_menge(2, 1) = 2
       artikel_und_menge(3, 0) = gabellasche
       artikel_und_menge(3, 1) = 1
       
   ElseIf .CheckBox1.Value = False Then
       num_komp_minus1 = 2
       
       .Label5.Visible = False
       .TextBox5.Visible = False
       
       .ToggleButton_Check.Top = 228
       .CommandButton_Add.Top = 228
       .CommandButton_Remove.Top = 228
       .ToggleButton_Hide.Top = 265
       .CommandButton_Back.Top = 265
       .CommandButton_Finish.Top = 265
       .Label00.Top = 302
       
       .Height = 435
       
       ReDim Preserve filter_list(2)
   End If
End With

If ToggleButton_Check.Value = True Then
ActiveSheet.Range("D:D").AutoFilter 4, filter_list(), xlFilterValues
End If
Application.ScreenUpdating = True
End Sub
---------------------------------------------------
Sub CommandButton_Back_Click()

Dim x As Integer
   For x = 0 To QP_non_count - 1
       ActiveSheet.Columns(Range(non_shooter_col(1, x)).Column).Hidden = False
   Next
UserForm_TS1.Hide
UserForm_Module.Show
--------------------------------------------------------
End Sub

Sub ToggleButton_Check_Click()

If ToggleButton_Check.Value = True Then
   ActiveSheet.Range("D:D").AutoFilter 4, filter_list(), xlFilterValues
End If

If ToggleButton_Check.Value = False Then
   ActiveSheet.ShowAllData
   ActiveSheet.Range("A2;D1000").AutoFilter last_qp, search_filter
End If

End Sub
---------------------------------------------------
Sub ToggleButton_Hide_Click()

If ToggleButton_Hide.Value = True Then
   Dim y As Integer
   For y = 0 To QP_non_count - 1
       ActiveSheet.Columns(Range(non_shooter_col(1, y)).Column).Hidden = True
   Next
End If
If ToggleButton_Hide.Value = False Then
   Dim z As Integer
   For z = 0 To QP_non_count - 1
       ActiveSheet.Columns(Range(non_shooter_col(1, z)).Column).Hidden = False
   Next
End If

End Sub
----------------------------------------------
Sub CommandButton_Add_Click()

'1. Abschnitt: Menegenangaben von Userform übernehmen
With UserForm_TS1
If OptionButton1.Value = True Then
   artikel_und_menge(0, 1) = .TextBox1.Value
   artikel_und_menge(1, 1) = .TextBox2.Value
   artikel_und_menge(2, 1) = .TextBox3.Value
   If CheckBox1.Value = True Then
       artikel_und_menge(3, 1) = .TextBox5.Value
   End If
End If

If OptionButton2.Value = True Then
   artikel_und_menge(0, 1) = .TextBox1.Value
   artikel_und_menge(1, 1) = .TextBox2.Value
   artikel_und_menge(2, 1) = .TextBox3.Value
   artikel_und_menge(3, 1) = .TextBox4.Value
   If CheckBox1.Value = True Then
       artikel_und_menge(4, 1) = .TextBox5.Value
   End If
End If

If OptionButton3.Value = True Then
   artikel_und_menge(0, 1) = .TextBox1.Value
   artikel_und_menge(1, 1) = .TextBox2.Value
   artikel_und_menge(2, 1) = .TextBox3.Value
   If CheckBox1.Value = True Then
       artikel_und_menge(3, 1) = .TextBox5.Value
   End If
End If

If OptionButton4.Value = True Then
   artikel_und_menge(0, 1) = .TextBox1.Value
   artikel_und_menge(1, 1) = .TextBox2.Value
   artikel_und_menge(2, 1) = .TextBox3.Value
   If CheckBox1.Value = True Then
       artikel_und_menge(3, 1) = .TextBox5.Value
   End If
End If
End With
'Ende 1. Abschnitt

'4. Abschnitt: Speichert Ziele für Stückliste (Zeilen) für Aufaddierung
Dim finden_artikel As Range                                                                             'Durchsucht Spalte 4 nach Artikel
Dim treffer_artikel                                                                                     'Wo wurde der Begriff gefunden? Angabe der Zeile
Dim shooter_row() As String                                                                                 'Array speichert Ziele für die Stückliste (Zeilen)
Dim p As Integer                                                                                        'Laufvariable
For p = 0 To num_komp_minus1
   Set finden_artikel = Columns(4).Find(what:=artikel_und_menge(p, 0))
   If Not finden_artikel Is Nothing Then
       treffer_artikel = finden_artikel.Address
       Do
       ReDim Preserve shooter_row(0 To 1, p)
           shooter_row(0, p) = finden_artikel.Value
           shooter_row(1, p) = finden_artikel.Address
       Set finden_artikel = Columns(4).FindNext(finden_artikel)
       Loop While Not finden_artikel Is Nothing And treffer_artikel <> finden_artikel.Address
   End If
Next
'Ende 4. Abschnitt

'5. Abschnitt: Speichert Ziel-Adressen für Aufaddierung
   Dim target()
   Dim q As Integer
   Dim s As Integer

   For s = 0 To QP_size - 1
       For q = 0 To num_komp_minus1
       ReDim Preserve target(0 To QP_size - 1, num_komp_minus1)
           target(s, q) = Cells(Range(shooter_row(1, q)).Row, Range(shooter_col(1, s)).Column).Address
       Next
   Next
'Ende 5. Abschnitt

'6. Abschnitt: Aufaddieren der Werte
   Dim x As Integer
   Dim y As Integer

   For x = 0 To QP_size - 1
       For y = 0 To num_komp_minus1
           Range(target(x, y)).Value = Range(target(x, y)).Value + artikel_und_menge(y, 1)
       Next
   Next
'Ende 6. Abschnitt

End Sub
------------------------------------------------------
Sub CommandButton_Remove_Click()

'1. Abschnitt: Menegenangaben von Userform übernehmen
With UserForm_TS1
If OptionButton1.Value = True Then
   artikel_und_menge(0, 1) = .TextBox1.Value
   artikel_und_menge(1, 1) = .TextBox2.Value
   artikel_und_menge(2, 1) = .TextBox3.Value
   If CheckBox1.Value = True Then
       artikel_und_menge(3, 1) = .TextBox5.Value
   End If
End If

If OptionButton2.Value = True Then
   artikel_und_menge(0, 1) = .TextBox1.Value
   artikel_und_menge(1, 1) = .TextBox2.Value
   artikel_und_menge(2, 1) = .TextBox3.Value
   artikel_und_menge(3, 1) = .TextBox4.Value
   If CheckBox1.Value = True Then
       artikel_und_menge(4, 1) = .TextBox5.Value
   End If
End If

If OptionButton3.Value = True Then
   artikel_und_menge(0, 1) = .TextBox1.Value
   artikel_und_menge(1, 1) = .TextBox2.Value
   artikel_und_menge(2, 1) = .TextBox3.Value
   If CheckBox1.Value = True Then
       artikel_und_menge(3, 1) = .TextBox5.Value
   End If
End If

If OptionButton4.Value = True Then
   artikel_und_menge(0, 1) = .TextBox1.Value
   artikel_und_menge(1, 1) = .TextBox2.Value
   artikel_und_menge(2, 1) = .TextBox3.Value
   If CheckBox1.Value = True Then
       artikel_und_menge(3, 1) = .TextBox5.Value
   End If
End If
End With
'Ende 1. Abschnitt

'4. Abschnitt: Speichert Ziele für Stückliste (Zeilen) für Aufaddierung
Dim finden_artikel As Range                                                                             'Durchsucht Spalte 4 nach Artikel
Dim treffer_artikel                                                                                     'Wo wurde der Begriff gefunden? Angabe der Zeile
Dim shooter_row() As String                                                                                 'Array speichert Ziele für die Stückliste (Zeilen)
Dim p As Integer                                                                                        'Laufvariable
For p = 0 To num_komp_minus1
   Set finden_artikel = Columns(4).Find(what:=artikel_und_menge(p, 0))
   If Not finden_artikel Is Nothing Then
       treffer_artikel = finden_artikel.Address
       Do
       ReDim Preserve shooter_row(0 To 1, p)
           shooter_row(0, p) = finden_artikel.Value
           shooter_row(1, p) = finden_artikel.Address
       Set finden_artikel = Columns(4).FindNext(finden_artikel)
       Loop While Not finden_artikel Is Nothing And treffer_artikel <> finden_artikel.Address
   End If
Next
'Ende 4. Abschnitt

'5. Abschnitt: Speichert Ziel-Adressen für Aufaddierung
   Dim target()
   Dim q As Integer
   Dim s As Integer

   For s = 0 To QP_size - 1
       For q = 0 To num_komp_minus1
       ReDim Preserve target(0 To QP_size - 1, num_komp_minus1)
           target(s, q) = Cells(Range(shooter_row(1, q)).Row, Range(shooter_col(1, s)).Column).Address
       Next
   Next
'Ende 5. Abschnitt

'6. Abschnitt: Substrahieren der Werte
   Dim x As Integer
   Dim y As Integer

   For x = 0 To QP_size - 1
       For y = 0 To num_komp_minus1
           If Range(target(x, y)).Value - artikel_und_menge(y, 1) >= 0 Then
               Range(target(x, y)).Value = Range(target(x, y)).Value - artikel_und_menge(y, 1)
           End If
       Next
   Next
'Ende 6. Abschnitt

End Sub
-----------------------------------------------------------------
Sub CommandButton_Finish_Click()

If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData

'Formular schliessen
Unload UserForm_TS1
Unload UserForm_Module

End Sub
---------------------------------------------------------------
Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData

'Formular schliessen
Unload UserForm_TS1
End Sub
------------------------------------------------------------
Sub TextBox1_Enter()
Set finden_auswahl = Columns(4).Find(what:=artikel_und_menge(0, 0))
ActiveSheet.Range(finden_auswahl.Address).EntireRow.Select
End Sub
--------------------------------------------------------------
Sub TextBox2_Enter()
Set finden_auswahl = Columns(4).Find(what:=artikel_und_menge(1, 0))
ActiveSheet.Range(finden_auswahl.Address).EntireRow.Select
End Sub
--------------------------------------------------------------
Sub TextBox3_Enter()
Set finden_auswahl = Columns(4).Find(what:=artikel_und_menge(2, 0))
ActiveSheet.Range(finden_auswahl.Address).EntireRow.Select
End Sub
---------------------------------------------------------------
Sub TextBox4_Enter()
Set finden_auswahl = Columns(4).Find(what:=artikel_und_menge(5, 0))
ActiveSheet.Range(finden_auswahl.Address).EntireRow.Select
End Sub
Suchen
Top
M.Wichmann Offline
pausiert
Registriert seit: 06.03.2017
Version(en): 2007
#2
04.06.2019, 09:34
Hallo,

ich bin zwar auch nicht der Experte, aber ich gehe mal davon aus, das es ziemlich normal ist. Du änderst ja was an der Userform.

Aber um das nachzuvollziehen solltest du die Datei anonymisiert hochladen. Hier wird die zum testen niemand nachbauen.
Suchen
Top
maninweb Offline
Benutzer
Registriert seit: 08.05.2014
Version(en): Office 2010, Office 365, Office 365 Betakanal
#3
04.06.2019, 09:43
Hallo,

Du könntest folgendes versuchen (allerdings ungetestet) ...

- Application.ScreenUpdating mal rausnehmen bzw. nur dort verwenden, wo in die Mappe geschrieben wird.
- DrawBuffer in den Eigenschaften mal erhöhen (z.B. von 32000 auf 64000).

Gruß
Microsoft Excel Expert · Microsoft Most Valuable Professional (MVP) :: 2011-2019 & 2020-2022 :: 10 Awards
https://de.excel-translator.de/translator :: Online Excel-Formel-Übersetzer :: Funktionen :: Fehlerwerte :: Argumente :: Tabellenbezeichner
Homepage Suchen
Top
Lopezoli Offline
pausiert
ThreadStarter
Registriert seit: 17.12.2018
Version(en): Office Professional Plus 2016
#4
04.06.2019, 09:54
Hier mal die Datei, hab sie ein bisschen abgespeckt, aber fürs Vorzeigen sollte es reichen.
Für den Start der Userform im Blatt rechts auf "Baugruppe einfügen" klicken. In der 1. Userform bei Baugruppe TS1 wählen und unten mindestens einen Mast auswählen, so gelangt man zur Userform wie im Video gezeigt. Und dann einfach mit den OptionButton und der Checkbox rumprobieren.


Angehängte Dateien
.xlsm   Materialliste hochladen.xlsm (Größe: 268,33 KB / Downloads: 7)
Suchen
Top
Lopezoli Offline
pausiert
ThreadStarter
Registriert seit: 17.12.2018
Version(en): Office Professional Plus 2016
#5
04.06.2019, 10:39
(04.06.2019, 09:34)M.Wichmann schrieb: Hallo,

ich bin zwar auch nicht der Experte, aber ich gehe mal davon aus, das es ziemlich normal ist. Du änderst ja was an der Userform.

Aber um das nachzuvollziehen solltest du die Datei anonymisiert hochladen. Hier wird die zum testen niemand nachbauen.

Aber sollten dann nicht alle Felder, Labels, Textboxen flackern? Nur einzelne tun dies..
Suchen
Top
schauan Offline
Einer von hier
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
#6
04.06.2019, 20:05
Hallöchen,

bei den Aktionen passiert ja auch einiges, was so nicht unbedingt nötig ist.

Ab und an poppen erst mal irgendwelche Texte oder Labels auf - da stimmt wohl irgendeine Reihenfolge im Code nicht
Eventuell gehst Du dazu den Code mal schrittweise durch und schaust, was wann passiert. Da siehst Du auch, ob eventuell unnötigerweise Ereignismakros ausgelöst werden, wenn Du die Inhalte oder Einstellungen von Objekten änderst.

Die Einträge einer Combo kannst Du auch schneller löschen.

Du könnest z.B. statt

Do While ComboBox1.ListCount > 0
ComboBox1.RemoveItem (0)
Loop

dann das nehmen:

ComboBox1.Clear

usw.

Ob z.B. die Einstellung der Schriftgröße usw. in jedem Fall nötig ist, bezweifle ich erst mal - muss aber gestehen, dass ich den Code jetzt nicht komplett durchgegangen bin.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Homepage Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste