Hallo,
leider gibt es bei meiner Userform immer noch probleme, es dürften aber kleinigkeiten sein, ich komme aber nicht drauf ![crying crying](https://www.vba-forum.de/ckeditor/plugins/smiley/images/cry_smile.png)
ein excel file im Forum Teilen geht nicht?
probleme die noch bestehen:
ich Filtere nach mehreren argumenten um zu entscheiden welche Daten in die Userform geladen werden.
- beim ersten mal starten bleibt die userform leer --> muss auf nächster eintrag klicken dan läd es, dadurch wird der erste treffer übersprungen
- die Filterfunktion dauert teilweise sehr lange oder buggt
ich hätte grundsätzlich ein file parat welches soweit bereinigt ist das ich es teilen kann/darf..
hier mal code ausschnitte..
sub Start() ist wenn man im excel file auf Start drückt...
Userform3 sind die filter parameter..
vielleicht kann mir wer helfen..
Sub Start()
i = 8
lrow1 = Worksheets("AIL").Cells(Rows.Count, 1).End(xlUp).Row + 1
UserForm3.Show
UserForm3.CheckBox1.Value = 1
UserForm3.CheckBox2.Value = 1
UserForm3.CheckBox3.Value = 0
UserForm3.CheckBox4.Value = 0
If halt = 1 Then
Exit Sub
Else
UserForm1.Show
MsgBox i
geklickt = True
Call Naechster_eintrag
UserForm1.Repaint
End If
End Sub
Sub Naechster_eintrag()
Do While i <= lrow1
Do
DoEvents
If geklickt = True Then Exit Do
Loop
If InStr(Join(arrAuswahl), Worksheets("AIL").Cells(i, 3).Value) <> 0 And (Worksheets("AIL").Cells(i, 10).Value = filter1 Or Worksheets("AIL").Cells(i, 10).Value = filter2 Or Worksheets("AIL").Cells(i, 10).Value = filter3 Or Worksheets("AIL").Cells(i, 10).Value = filter4) Then
Call Eintrag_Laden
j = i
geklickt = False
End If
Loop
End Sub
Sub Eintrag_Laden()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim presel1 As Integer
Dim lngPos As Long
Dim rngItems As Range
Dim oDictionary As Object
With Worksheets("AIL")
'Nr.--------------------------------------------------------------------
UserForm1.TextBox6.Value = Worksheets("AIL").Cells(i, 1).Value
'Beschreibung der Aktion--------------------------------------------------------------------
UserForm1.TextBox3.Value = Cells(i, 5).Value
'Update der Aktion--------------------------------------------------------------------
textboxin = Format(Now, "dd.mm.yyyy") & " - " & Application.UserName & ": "
UserForm1.TextBox5.Value = textboxin
With UserForm1.TextBox5
lngPos = InStr(1, .Value, vbCr) - 1
If lngPos > 0 Then
.SelStart = lngPos
Else
.SelStart = .TextLength
End If
Call .SetFocus
End With
'Aktionsverlauf--------------------------------------------------------------------
UserForm1.TextBox1.Value = Cells(i, 6).text
'Verantwortlich--------------------------------------------------------------------
UserForm1.TextBox2.Value = Cells(i, 7).Value
'Verantwortlich neu (Projektteamliste laden)-------------------------------------------------------------------
With Worksheets("Projektteam")
UserForm1.ComboBox1.List = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
End With
UserForm1.ComboBox1.ListIndex = -1
'Bereich --------------------------------------------------------------------
If .Cells(i, 3).Value <> "" Then UserForm1.ComboBox3.Value = .Cells(i, 3).Value
Set rngItems = Range("C8:C" & lrow1)
Set oDictionary = CreateObject("Scripting.Dictionary")
With UserForm1.ComboBox3
For Each cel In rngItems
If oDictionary.exists(cel.Value) Then
'Do Nothing
Else
oDictionary.Add cel.Value, 0
.AddItem cel.Value
End If
Next cel
End With
'Termin--------------------------------------------------------------------
UserForm1.TextBox4.Value = Cells(i, 8).Value
date1 = Cells(i, 8).Value
'Status--------------------------------------------------------------------
status_B = Worksheets("AIL").Cells(i, 10).Value
If Cells(i, 10).Value = "open" Then
UserForm1.CommandButton1.BackStyle = fmBackStyleOpaque
UserForm1.CommandButton2.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton3.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton4.BackStyle = fmBackStyleTransparent
status_B = "open"
ElseIf Cells(i, 10).Value = "in work" Then
UserForm1.CommandButton1.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton2.BackStyle = fmBackStyleOpaque
UserForm1.CommandButton3.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton4.BackStyle = fmBackStyleTransparent
status_B = "in work"
ElseIf Cells(i, 10).Value = "on hold" Then
UserForm1.CommandButton1.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton2.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton3.BackStyle = fmBackStyleOpaque
UserForm1.CommandButton4.BackStyle = fmBackStyleTransparent
status_B = "on hold"
ElseIf Cells(i, 10).Value = "closed" Then
UserForm1.CommandButton1.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton2.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton3.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton4.BackStyle = fmBackStyleOpaque
status_B = "closed"
ElseIf neuerEintrag = 1 Then
UserForm1.CommandButton1.BackStyle = fmBackStyleOpaque
UserForm1.CommandButton2.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton3.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton4.BackStyle = fmBackStyleTransparent
status_B = "open"
Else
UserForm1.CommandButton1.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton2.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton3.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton4.BackStyle = fmBackStyleTransparent
status_B = ""
End If
'Prio--------------------------------------------------------------------
Prio_A = Worksheets("AIL").Cells(i, 4).Value
If Cells(i, 4).Value = "A" Then
UserForm1.CommandButton10.BackStyle = fmBackStyleOpaque
UserForm1.CommandButton11.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton12.BackStyle = fmBackStyleTransparent
Prio_B = "A"
ElseIf Cells(i, 4).Value = "B" Then
UserForm1.CommandButton10.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton11.BackStyle = fmBackStyleOpaque
UserForm1.CommandButton12.BackStyle = fmBackStyleTransparent
Prio_B = "B"
ElseIf Cells(i, 4).Value = "C" Then
UserForm1.CommandButton10.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton11.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton12.BackStyle = fmBackStyleOpaque
Prio_B = "B"
Else
UserForm1.CommandButton10.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton11.BackStyle = fmBackStyleTransparent
UserForm1.CommandButton12.BackStyle = fmBackStyleTransparent
Prio_B = ""
End If
'---------------------------------------------
History = 1
End With
UserForm1.Repaint
End Sub
![](C:\Users\thstehr\Desktop\screenshot.JPG)
|