Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen

UF mit ListBox Einträge mehrere Sheets

nach unten

Betrifft: UF mit ListBox Einträge mehrere Sheets von: Peer
Geschrieben am: 01.10.2020 13:43:05

Hallo liebe VBA Excel Gemeinde.
Ich möchte gern eine UF mit einer ListBox und verschiedenen Filtern erstellen und würde für mein Verständnis dieser VBA-Programmierung schrittweise beginnen. Hier hoffe ich auf eure Hilfe und möchte mich im Voraus schon einmal für jegliche Unterstützung bedanken.
Ebenfalls könnte jeder Anfänger diesen Thread als Hilfestellung lesen und nutzen. Ich hoffe ebenfalls auf Nachsicht für Nachfragen und eventuelle Verständnisprobleme.
Ich möchte nun beginnen.

Ich habe eine Mappe mit mehreren Registern, wovon 2 Monatsregister (es werden später 12 Monate) einen Kalender darstellen. Hier trage ich ab Zelle B7 (Kalendertag) bis L37 (Dauer) alle erforderlichen Daten Zeile für Zeile für jeden Tag ein. Ab Zelle D7 bis Zelle L7 jeder Zeile usw. wird die Dienstreise für jeden Tag erfaßt.
Ich möchte nun alle Tage, in welche in den Zeilen (L7:L37) Daten für die Dienstreise stehen über alle Monatsregister in einer UF auflisten. Es werden auch Tage ohne Dienstreise vorhanden sein, die hier rausgenommen werden sollen.

Als erstens erstelle ich die UF mit einer ListBox, die ich "lst_Dienstreisen" nenne.
Wie kann ich die Daten von jedem Monatsregister in die ListBox "lst_Dienstreisen" einlesen?

Hier eine sehr vereinfachte Form der Mappe...
https://www.herber.de/bbs/user/140569.xlsm

LG Peer

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Nepumuk
Geschrieben am: 01.10.2020 13:51:21

Hallo Peer,

welche Spalten sollen in die ListBox?

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Peer
Geschrieben am: 01.10.2020 13:59:02

Hallo Nepumuk.
Stimmt, das hatte ich vergessen, zu erwähnen.
Zur Übung würde ich nur die Spalte B weglassen. Am Ende der Liste möchte ich noch eine "berechnende" Spalte mit Auslistung der Pauschalkosten einfügen (z.B. < 8Std = 0 Euro, > 8Std Dauer = 12 Euro, 24Std = 24 Euro).

Übrigens beginnt die Spalte "Kalendertag" bei A nicht wie oben geschrieben bei B. Sorry.

MFG
Peer

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Nepumuk
Geschrieben am: 01.10.2020 14:34:01

Hallo Peer,

du musst noch in den Eigenschaften der ListBox bei ColumnCount eine 10 eingeben.

Option Explicit

Private Sub btn_OK_Click()
    Call Unload(Object:=Me)
End Sub

Private Sub UserForm_Initialize()
    Dim lngMonth As Long, ialngIndex As Long, lngRow As Long, lngColumn As Long
    Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant
    For lngMonth = 1 To 2 'auf 12 Monate erhöhen!!!
        lngRow = 6
        With Worksheets(MonthName(Month:=lngMonth))
            Do
                lngRow = .Cells(lngRow, 4).End(xlDown).Row
                If lngRow < .Rows.Count Then
                    Redim Preserve avntValues(9, ialngIndex)
                    lngColumn = 0
                    avntTemp = .Range(.Cells(lngRow, 4), .Cells(lngRow, 12)).Value
                    For Each vntItem In avntTemp
                        Select Case lngColumn
                            Case 1, 5, 8
                                avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn")
                                If lngColumn = 8 Then
                                    Select Case vntItem
                                        Case Is < TimeSerial(8, 0, 0)
                                            avntValues(9, ialngIndex) = "0,00 €"
                                        Case Is >= TimeSerial(24, 0, 0)
                                            avntValues(9, ialngIndex) = "24,00 €"
                                        Case Is > TimeSerial(8, 0, 0)
                                            avntValues(9, ialngIndex) = "12,00 €"
                                        Case Else
                                            avntValues(9, ialngIndex) = "Fehler"
                                            Debug.Print vntItem
                                    End Select
                                End If
                            Case Else
                                avntValues(lngColumn, ialngIndex) = vntItem
                        End Select
                        lngColumn = lngColumn + 1
                    Next
                    ialngIndex = ialngIndex + 1
                Else
                    Exit Do
                End If
            Loop
        End With
    Next
    lst_Dienstreise.Column = avntValues
End Sub

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Peer
Geschrieben am: 01.10.2020 14:54:12

Genial, Nepumuk. Sieht ja super aus. Da werde ich mal den Code "durchdenken". Eine bisschen Erklärung wäre hilfreich.
Ich habe die Uf ein wenig verändert, was ich noch hinzufügen möchte.
Spalte B würde ich als "Grund" noch hinzunehmen.

https://www.herber.de/bbs/user/140571.xlsm
Gruß
Peer

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Nepumuk
Geschrieben am: 01.10.2020 14:58:59

Hallo Peer,

willst du neben der Spalte B auch noch die Spalten M bis O in der ListBox haben?

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Peer
Geschrieben am: 01.10.2020 19:28:09

Hallo Nepumuk.

Die Spalten M-O wollte ich für die Filter nutzen. Angezeigt können sie auch werden. Schadet eigentlich nicht.

Eins habe ich noch vergessen zu erwähnen. Durch Doppelklick auf einen Listeneintrag oder über einen Button möchte ich in den jeweiligen Datensatz wechseln, um ihn z.B. zu editieren.



LG

Peer

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Nepumuk
Geschrieben am: 02.10.2020 12:00:12

Hallo Peer,

teste mal:

Private Sub lst_Dienstreise_Click()
    Dim avntAddress As Variant
    With lst_Dienstreise
        avntAddress = Split(.List(.ListIndex, 14), "|")
    End With
    Call Application.Goto(Reference:=Worksheets(avntAddress(0)).Cells(avntAddress(1), 1))
End Sub

Private Sub UserForm_Initialize()
    Dim lngMonth As Long, ialngIndex As Long, lngRow As Long, lngColumn As Long
    Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant
    For lngMonth = 1 To 2 'auf 12 Monate erhöhen!!!
        lngRow = 6
        With Worksheets(MonthName(Month:=lngMonth))
            Do
                If IsEmpty(.Cells(lngRow + 1, 4).Value) Then
                    lngRow = .Cells(lngRow, 4).End(xlDown).Row
                Else
                    lngRow = lngRow + 1
                End If
                If lngRow < .Rows.Count Then
                    Redim Preserve avntValues(14, ialngIndex)
                    avntValues(0, ialngIndex) = .Cells(lngRow, 2).Value
                    lngColumn = 1
                    avntTemp = .Range(.Cells(lngRow, 4), .Cells(lngRow, 15)).Value
                    For Each vntItem In avntTemp
                        Select Case lngColumn
                            Case 2, 6, 9
                                avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn")
                                If lngColumn = 9 Then
                                    Select Case vntItem
                                        Case Is < TimeSerial(8, 0, 0)
                                            avntValues(10, ialngIndex) = "0,00 €"
                                        Case Is >= TimeSerial(24, 0, 0)
                                            avntValues(10, ialngIndex) = "24,00 €"
                                        Case Is > TimeSerial(8, 0, 0)
                                            avntValues(10, ialngIndex) = "12,00 €"
                                        Case Else
                                            avntValues(10, ialngIndex) = "Fehler"
                                            Debug.Print vntItem
                                    End Select
                                    lngColumn = lngColumn + 1
                                End If
                                lngColumn = lngColumn + 1
                            Case Else
                                avntValues(lngColumn, ialngIndex) = vntItem
                                lngColumn = lngColumn + 1
                        End Select
                    Next
                    avntValues(14, ialngIndex) = .Name & "|" & CStr(lngRow)
                    ialngIndex = ialngIndex + 1
                Else
                    Exit Do
                End If
            Loop
        End With
    Next
    lst_Dienstreise.Column = avntValues
End Sub

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Peer
Geschrieben am: 02.10.2020 13:02:25

Vielen Dank, Nepumuk.
Es funktioniert sehr gut.
Ich habe das Userform_Initialize Event noch ein wenig angepaßt, um die ListBox nicht so breit zu machen. Und ich habe in der Tabelle als Spalte 4 einen Reisezweck definiert und lasse ihn in der ListBox anzeigen, statt Spalte 2 (die eigentlich eine Tätigkeit ist). In den Eigenschaften der Listbox habe ich ColumnCount auf 11 und die ColumnWidths definiert und die UF auf ShowModal = False gesetzt.
Private Sub UserForm_Initialize()
Dim lngMonth As Long, ialngIndex As Long, lngRow As Long, lngColumn As Long
Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant

    For lngMonth = 1 To 2 'auf 12 Monate erhöhen!!!
        lngRow = 6
        With Worksheets(MonthName(Month:=lngMonth))
            Do
                If IsEmpty(.Cells(lngRow + 1, 4).Value) Then
                    lngRow = .Cells(lngRow, 4).End(xlDown).Row 
                Else
                    lngRow = lngRow + 1
                End If
                If lngRow < .Rows.Count Then
                    ReDim Preserve avntValues(14, ialngIndex)
                    avntValues(0, ialngIndex) = .Cells(lngRow, 2).Value
                    lngColumn = 0
                    avntTemp = .Range(.Cells(lngRow, 4), .Cells(lngRow, 13)).Value
                    For Each vntItem In avntTemp
                        Select Case lngColumn
                            Case 2, 6, 9
                                avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn")
                                If lngColumn = 9 Then
                                    Select Case vntItem
                                        Case Is < TimeSerial(8, 0, 0)
                                            avntValues(10, ialngIndex) = "00,00 €"
                                        Case Is >= TimeSerial(24, 0, 0)
                                            avntValues(10, ialngIndex) = "24,00 €"
                                        Case Is > TimeSerial(8, 0, 0)
                                            avntValues(10, ialngIndex) = "12,00 €"
                                        Case Else
                                            avntValues(10, ialngIndex) = "Fehler"
                                            Debug.Print vntItem
                                    End Select
                                    lngColumn = lngColumn + 1
                                End If
                                lngColumn = lngColumn + 1
                            Case Else
                                avntValues(lngColumn, ialngIndex) = vntItem
                                lngColumn = lngColumn + 1
                        End Select
                    Next
                    avntValues(14, ialngIndex) = .Name & "|" & CStr(lngRow)
                    ialngIndex = ialngIndex + 1
                Else
                    Exit Do
                End If
            Loop
        End With
    Next
    lst_Dienstreise.Column = avntValues
End Sub
Jetzt habe ich ein Problem entdeckt, bei dem ich im Internet und auch hier im Forum keine Lösung gefunden habe.
Bei der Reise z.B. am 17.01.2018 ist der Beginn um 0:00 und endet 24:00 (oder am 18.01.2018 0:00). Als Ergebnis wird mir in der ListBox aber 0:00 angezeigt, obwohl mit 24:00 gerechnet wird. Wie kann ich die Anzeige dazu ändern?
Hierzu habe ich in der Tabelle Hilfspalten eingefügt, die die Berechnung durchführen.
Ich übersende die angepaßte Datei.
https://www.herber.de/bbs/user/140592.xlsm
LG Peer

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Nepumuk
Geschrieben am: 02.10.2020 13:07:25

Hallo Peer,

24:00 Uhr gibt es nicht. Nach 23:59:59 folgt 00:00:00 Uhr. Das lässt sich mit der Format-Funktion nicht darstellen. Soll ich das hart kodieren?

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Peer
Geschrieben am: 02.10.2020 13:22:35

Hallo Nepumuk.
Was meinst du mit hart kodieren?

LG
Peer

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: max.kaffl@gmx.de
Geschrieben am: 02.10.2020 15:00:44

Hallo Peer,

so:

Private Sub UserForm_Initialize()
    Dim lngMonth As Long, ialngIndex As Long, lngRow As Long, lngColumn As Long
    Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant
    For lngMonth = 1 To 2 'auf 12 Monate erhöhen!!!
        lngRow = 6
        With Worksheets(MonthName(Month:=lngMonth))
            Do
                If IsEmpty(.Cells(lngRow + 1, 4).Value) Then
                    lngRow = .Cells(lngRow, 4).End(xlDown).Row
                Else
                    lngRow = lngRow + 1
                End If
                If lngRow < .Rows.Count Then
                    Redim Preserve avntValues(14, ialngIndex)
                    avntValues(0, ialngIndex) = .Cells(lngRow, 2).Value
                    lngColumn = 1
                    avntTemp = .Range(.Cells(lngRow, 4), .Cells(lngRow, 15)).Value
                    For Each vntItem In avntTemp
                        Select Case lngColumn
                            Case 2, 6, 9
                                avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn")
                                If lngColumn = 6 Then
                                    If vntItem >= TimeSerial(24, 0, 0) Then avntValues(6, ialngIndex) = "24:00"
                                ElseIf lngColumn = 9 Then
                                    Select Case vntItem
                                        Case Is < TimeSerial(8, 0, 0)
                                            avntValues(10, ialngIndex) = "0,00 €"
                                        Case Is >= TimeSerial(24, 0, 0)
                                            avntValues(10, ialngIndex) = "24,00 €"
                                            avntValues(9, ialngIndex) = "24:00"
                                        Case Is > TimeSerial(8, 0, 0)
                                            avntValues(10, ialngIndex) = "12,00 €"
                                        Case Else
                                            avntValues(10, ialngIndex) = "Fehler"
                                            Debug.Print vntItem
                                    End Select
                                    lngColumn = lngColumn + 1
                                End If
                                lngColumn = lngColumn + 1
                            Case Else
                                avntValues(lngColumn, ialngIndex) = vntItem
                                lngColumn = lngColumn + 1
                        End Select
                    Next
                    avntValues(14, ialngIndex) = .Name & "|" & CStr(lngRow)
                    ialngIndex = ialngIndex + 1
                Else
                    Exit Do
                End If
            Loop
        End With
    Next
    lst_Dienstreise.Column = avntValues
End Sub

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Peer
Geschrieben am: 02.10.2020 18:40:30

Hallo Nepumuk.

Funktioniert wie immer. Vielen Dank für deine Arbeit.

Ich habe unten ein kleines Label-Steuerelement "Status", bei dem bei Klick auf einen Listeneintrag sich der "Status" ändert, und zwar wenn abhängig von den Zellen "eingereicht", "abgerechnet" bzw. "gezahlt" Datumswerte stehen, und genau in dieser Hierarchie. Also if ...
"eingereicht" = "" Then lbl_Status.Value = "offen"
"abgerechnet" = "" Then lbl_Status.Value = "eingereicht"
"gezahlt" = "" Then lbl_Status.Value = "abgerechnet"
"gezahlt" <> "" Then lbl_Status.Value = "bezahlt"

Wo und wie kann ich dies in das lst_Dienstreise_Click Event einbauen?

https://www.herber.de/bbs/user/140602.xlsm

Beste Grüße
Peer

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: max.kaffl@gmx.de
Geschrieben am: 02.10.2020 20:00:39

Hallo Peer,

gibt es andere Gründe wie:

Schicht
Ruhe
Ausbilder
Krank

Gruß
Nepumuk
PS.: Ich bin dabei deine Mappe fertig zu machen. Die Monatsauswahl habe ich schon drin.

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Nepumuk
Geschrieben am: 03.10.2020 08:24:27

Hallo Peer,

ich warte jetzt mal ab bis du alle Änderungen in der Mappe hast. Dann sag mir Bescheid.

Gruß
Nepumuk

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Peer
Geschrieben am: 03.10.2020 11:32:31

Hallo Nepumuk.
Im Prinzip bin ich mit der Mappe und der UF grob fertig. Vielleicht kommen später noch ästhetisches hinzu, aber von den Daten her sollte alles passen.
Die in der UF enthaltenen ComboBoxen würde ich noch füllen. Die anzuzeigenden Inhalte habe ich unter die Felder geschrieben.
Dabei soll in der ComboBox "Monat" alle Monate der Mappe eingelesen werden, mit denen ich die ListBox danach filtere und es sollte mit Auswahl "alle Monate" alle Einträge angezeigt werden. Die würde ich als Standard beim Öffnen der UF festlegen.
Mit zweiter ComboBox möchte ich die Einträge nach Reisezwecke filtern und auch hier als Standard "alle Reisezwecke" anzeigen lassen. Dabei sollte die ComboBox abhängig von "Monat" sein. Also wenn es in einem Monat kein ausgewählter Reisezweck gibt, sollte ListBox leer sein.
Analog verhält es sich mit dritter ComboBox.

https://www.herber.de/bbs/user/140612.xlsm

P.S. Vielleicht hast du Zeit für ein paar Kommentare in deinem Code zum Verständnis für mich.

Nochmals vielen Dank für deine Mühe.

LG
Peer

nach oben  nach unten

Betrifft: AW: UF mit ListBox Einträge mehrere Sheets
von: Peer
Geschrieben am: 01.10.2020 20:26:17

Hallo Nepumuk.
Ich habe noch ein wenig angepasst.

https://www.herber.de/bbs/user/140576.xlsm

LG
Peer