Office: Listbox abfrage

Hallo liebes Forum, ich hab eine knifflige Frage.
Der letzte Step meines Projektes.

In einer Listbox befinden sich die Daten der Mitarbeiter (Name, Kostenstelle und Stunden)
Auf dem Excel Blatt soll nun die Daten eingetragen werden, damit sie ausgedruckt werden können.

Soweit so gut, das hab ich schon realisiert:

PHP:

         Dim loletzte As Long

loletzte = ListBox1.ListCount - 1  letzte beschriebene zelle


For N = 0 To ListBox1.ListCount - 1

Cells(N + 6, "A") = ListBox1.List(N, 0)
Cells(N + 6, "B") = ListBox1.List(N, 1)
usw.......
Next


:)

 

Hallo Jürgen,

das geht auch ohne Schleife:

Private Sub CommandButton1_Click()
Cells(6, 1).Resize(ListBox1.ListCount, 3).Value = ListBox1.List
End Sub

 

Hi Nepumum.

Vielleicht verstehst du mich falsch, ich versuche es noch einmal detailierter:

Also in der Listbox befinden sich alle Daten
im Datenblatt "Übersicht" sind in Reihe 5 alle Kostenstellen aufgelistet
in Spalte "A" alle Mitarbeiter

der User wählt nun Jahr und Monat, Die Liste wird nun dementsprechend gefiltert.
in Spalte 1 der Listbox kann natürlich jetzt x mal die selbe Person stehen.

mögliches Ergebniss in Listbox:

PHP:

         Name:          Kostenstelle:   Stunden:
Jürgen Unterweger     kst1             2
Jürgen Unterweger     kst1             3
Jürgen Unterweger     kst2             2
Hans Meier            kst1             8
Franz Huber           kst2             2
usw......


 

Hallo Jürgen,

kannst du eine Mustermappe hochladen?

 

Hi Nepumuk

Um das Projekt im gesamten zu verstehen ist es notwendig die original Datei hoch zu laden.

Zum zurechtfinden:
1. unter "Optionen" muss Die Kostenstelle eingefügt werden (Tabellenblatt Kostenstelle ist hier die Source)
2.) unter "Userboard" werden neue Benutzer bzw. Feuerwehrkameraden angelegt (Tabellenblatt Login ist hier die Source)
3.) im "Stundenmanager" können nun neue Daten angelegt werden, dabei muss Name, Datum und Zeitbereich eingegeben werden. (Tabellenblatt "Daten" ist hier die Source)

Filtern funktioniert alles sehr gut.
Der Button drucken, soll die aktuelle Liste ausdrucken. Das passt so, dabei werden die aktuellen gefilterten Daten der Listbox in das Tabellenblatt "Drucken" kopiert, der Druckberreich festgelegt und gedruckt.

so und nun gehts um mein Problem.

Beim klick des Buttons "Monatsbericht drucken" sollen die Werte aus dem gewählten Jahr und Monat gefiltert werden. Das ist e schon realisiert.

Jetzt müssen die Werte ins Tabellenblatt "Übersicht" übertragen werden.

Zum Tabellenblatt "Übersicht"
- Die Namen werden vom Tabellenblatt "Login" übernommen
- Die Kostenstellen vom Tabellenblatt "Kostenstelle"

Kamerad Hans Meier hat im Monat Mai zb. 3 Stunden in kst.1 gearbeitet und 2 Stunden in kst.2
jetzt muss im Tabellenblatt "Übersicht" in der Zeile von Hans Meier 3 Stunden in die Spalte kst.1 und 2 STunden in kst.2 eingetragen werden.

und so soll die gesamte Liste, bis zum letzten Kameraden durchgegangen werden.

Hier der Link zur Excel Datei, leider ist hier ein upload von der größe sehr beschrängt:
http://www.alpinfreunde.at/TEST/Workmanager.xlsm

Boooa, ich hoffe du verstehst mich und kannst und willst mir helfen
Lg Jürgen

 

Hallo Jürgen,

um welches Userform geht es? Und welche Tabelle?

 

Userform: Stundenmanager
Blatt: Übersicht

im Bereich "Filter" muss Jahr und Monat gewählt werden.
Im Anschluss sollte durch klicken des Button "Monatsbericht drucken" die Daten in das Blatt Übersicht richtig eingeordnet werden

 

Hallo Jürgen,

so?

Private Sub CommandButton18_Click()

Dim lngIndex As Long

If b Then Exit Sub

b = True

With Worksheets("daten").Range("a3:i3")

.AutoFilter Field:=7, Criteria1:=ComboBox2.Value
.AutoFilter Field:=8, Criteria1:=ComboBox3.Value

End With

With Worksheets("Übersicht")

For lngIndex = 0 To ListBox1.ListCount - 1

.Cells(lngIndex + 6, 1).Value = ListBox1.List(lngIndex, 0)

Select Case ListBox1.List(lngIndex, 1)
Case "kst1": .Cells(lngIndex + 6, 4).Value = ListBox1.List(lngIndex, 5)
Case "kst2": .Cells(lngIndex + 6, 5).Value = ListBox1.List(lngIndex, 5)
Case "kst3": .Cells(lngIndex + 6, 6).Value = ListBox1.List(lngIndex, 5)
End Select
Next
End Sub

 

Hi Nepumuk.

Nein leider nicht.....
da Kostenstellen und Namen individuell sind.

Der Benutzer kann im Vorfeld unter "Optionen" Kostenstellen hinzufügen und löschen.
so wie er auch die Namen unter "Userboard" hinzufügen und ändern kann.

Gibt er nun in "Optionen" Beispielsweise eine neue Kostenstelle ein, wird das Tabellenblatt um diese Kostenstelle erweitert.

Das gleiche gilt bei den namen.

deswegen muss beim klicken des "Monatsübersicht drucken" Button die Listbox durchgegangen werden....

welche Namen und kostenstellen sind in der Listbox

ist beispielsweise 1 oder mehrere Einträge des Namens "Jürgen Unterweger" vorhanden. Muss weiter in der Listbox gesucht werden welche "Kostenstellen" vorhanden sind. Und dann die Werte (Stunden) in die richtige Zelle addiert werden.

Jürgen Unterweger hat im Monat Mai 3 Stunden in der Kostenstelle "kst1" und 5 Stunden in der "kst2" und ein weiteres mal 8 Stunden wieder in der Kostenstelle "kst1" gearbeitet.
In der Tabelle "Übersicht" soll nun in der Zeile "Jürgen Unterweger"
in der Spalte "kst1" 11 stehen. Und in der Spalte "kst2" 5 stehen.

Das ganze geht natürlich mit allen anderen Namen in der Liste weiter.
Sehr tricky ich weiß *rolleyes.gif*

Ich könnte mir vorstellen das es aber gehen müsste, wenn nicht hab ich ein Problem da es eine gaaanz wichtige Funktion ist. Wenn nicht sogar die wichtigste.

Jedenfalls sehr nett von dir das du dich bemühst mir zu helfen

Lg Jürgen

 

Hallo Jürgen,

so besser?

Private Sub CommandButton18_Click()

Dim lngIndex As Long, ialngIndex As Long, ialngKey As Long
Dim avntValues() As Variant
Dim objDictionary As Object

If b Then Exit Sub

b = True

With Worksheets("daten").Range("a3:i3")

.AutoFilter Field:=7, Criteria1:=ComboBox2.Value
.AutoFilter Field:=8, Criteria1:=ComboBox3.Value

End With

Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

For lngIndex = 0 To ListBox1.ListCount - 1

If Not objDictionary.Exists(ListBox1.List(lngIndex, 0)) Then

ialngIndex = ialngIndex + 1

Redim Preserve avntValues(1 To 30, 1 To ialngIndex)

objDictionary.Item(ListBox1.List(lngIndex, 0)) = ialngIndex

End If

ialngKey = objDictionary.Item(ListBox1.List(lngIndex, 0))

avntValues(1, ialngKey) = ListBox1.List(lngIndex, 0)

Select Case ListBox1.List(lngIndex, 1)
Case "kst1": avntValues(4, ialngKey) = ListBox1.List(lngIndex, 5)
Case "kst2": avntValues(5, ialngKey) = ListBox1.List(lngIndex, 5)
Case "kst3": avntValues(6, ialngKey) = ListBox1.List(lngIndex, 5)
End Select
Next

With Worksheets("Übersicht")

.Cells(6, 1).Resize(UBound(avntValues, 2), UBound(avntValues, 1)).Value = Application.Transpose(avntValues)

End With

Set objDictionary = Nothing

b = False

End Sub

 

PHP:

         Case "kst1": avntValues(4, ialngKey) = ListBox1.List(lngIndex, 5)
Case "kst2": avntValues(5, ialngKey) = ListBox1.List(lngIndex, 5)
Case "kst3": avntValues(6, ialngKey) = ListBox1.List(lngIndex, 5)


 

Hallo Jürgen,

Moment, hab noch was vergessen.

 

Hallo Jürgen,

schau mal ob es so passt:

Private Sub CommandButton18_Click()

Dim lngIndex As Long, lngRow As Long, ialngKey As Long
Dim avntValues() As Variant
Dim objDictionary As Object
Dim objCell As Range

If b Then Exit Sub

b = True

With Worksheets("daten").Range("a3:i3")

.AutoFilter Field:=7, Criteria1:=ComboBox2.Value
.AutoFilter Field:=8, Criteria1:=ComboBox3.Value

End With

Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

With Worksheets("Übersicht")

For lngRow = 6 To .Cells(.Rows.Count, 1).End(xlUp).Row

objDictionary.Item(.Cells(lngRow, 1).Value) = lngRow - 5

Next
End With

Redim avntValues(1 To objDictionary.Count, 1 To 30)

For lngIndex = 0 To ListBox1.ListCount - 1

ialngKey = objDictionary.Item(ListBox1.List(lngIndex, 0))

Set objCell = Worksheets("Übersicht").Rows(5).Find(What:=ListBox1.List(lngIndex, 1), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

If Not objCell Is Nothing Then

avntValues(ialngKey, objCell.Column - 3) = ListBox1.List(lngIndex, 5)

Else
Call MsgBox("Kostenstelle ''" & ListBox1.List(lngIndex, 1) & _
"'' nicht gefunden.", vbExclamation, "Hinweis")
End If
Next

With Worksheets("Übersicht")

.Cells(6, 4).Resize(UBound(avntValues, 1), UBound(avntValues, 2)).Value = avntValues

End With

Set objDictionary = Nothing

b = False

End Sub

 

Du bist ein Traum *Smilie

Es schaut nach dem 1. Test so aus als ob es funktionieren würde.

Nur eines ist mir aufgefallen:

Wenn zb.:
Jürgen Unterweger
1x 5 Stunden in der Kostenstell "kst1" gearbeitet hat und später
1x 2 Stunden in der Kostenstell "kst1" gearbeitet hat

wird in die korrekte Spalte nicht 7 kopiert sondern 2

Da müsste addiert werden
Lg Jürgen

 

Hallo Jürgen,

na wenn's nicht mehr ist:

Private Sub CommandButton18_Click()

Dim lngIndex As Long, lngRow As Long, ialngKey As Long
Dim avntValues() As Variant
Dim objDictionary As Object
Dim objCell As Range

If b Then Exit Sub

b = True

With Worksheets("daten").Range("a3:i3")

.AutoFilter Field:=7, Criteria1:=ComboBox2.Value
.AutoFilter Field:=8, Criteria1:=ComboBox3.Value

End With

Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

With Worksheets("Übersicht")

For lngRow = 6 To .Cells(.Rows.Count, 1).End(xlUp).Row

objDictionary.Item(.Cells(lngRow, 1).Value) = lngRow - 5

Next
End With

Redim avntValues(1 To objDictionary.Count, 1 To 30)

For lngIndex = 0 To ListBox1.ListCount - 1

ialngKey = objDictionary.Item(ListBox1.List(lngIndex, 0))

Set objCell = Worksheets("Übersicht").Rows(5).Find(What:=ListBox1.List(lngIndex, 1), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

If Not objCell Is Nothing Then

avntValues(ialngKey, objCell.Column - 3) = avntValues(ialngKey, objCell.Column - 3) + _
CDbl(ListBox1.List(lngIndex, 5))

Else
Call MsgBox("Kostenstelle ''" & ListBox1.List(lngIndex, 1) & _
"'' nicht gefunden.", vbExclamation, "Hinweis")
End If
Next

With Worksheets("Übersicht")

.Cells(6, 4).Resize(UBound(avntValues, 1), UBound(avntValues, 2)).Value = avntValues

End With

Set objDictionary = Nothing

b = False

End Sub