VBA Code erläutern

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 = TimeSerial(24, 0, 0) Then avntValues(6, _ ialngIndex) = "24:00" ElseIf lngColumn = 9 Then Select Case vntItem 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
naja im Grunde wäre Nepumuk hier der richtige Ansprechpartner.
Aber soweit ich dieses Konstrukt nun durchschaut habe, bestimmst du den angezeigten Wert mit den Case Unterscheidungen. Case geht hier auf die Spaltennr. der Listbox. Ich ging davon aus das die Kosten und die Dauer einfach eine Zelle in der Tabelle sind. Wenn du die extra berechnen mußt, dann gibt es dafür schon zig Beispiele. Arbeitszeitberechnungen werden ständig angefragt. Unter Berücksichtigung von diversen Ländersätzen bei den VMA/Auslöse würde ich nicht nur auf Österreich oder Deutschland abstellen. ´Man weis ja nicht was später noch kommt.
Bastel dir eine Funktion, die du mit den Notwendigen Werten fütterst und nutze einen Rückgabewert zum Füllen der Array Werte. Das macht es etwas übersichtlicher. Die Profis hier basteln gern so kryptisch wie möglich. Da versteht man aber den Code schon nach ner Woche nicht mehr, wenn was angepasst werden muß. Lieber bissel ausführlicher und gut dokumentieren.
z.b.
avntTemp(1, 7) = functionberechneDauer( datum anfang , Datum ende )
avntTemp(1, 8) = functionberechneKosten(dauer, Länderwert)
hier im code wird nur auf die drei Spalten der Listbox abfgefragt weil die Werte als Zeit formatiert angezeigt werden sollen.
Case 2, 5, 7
avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn")
Ich halte die Ortsangaben für ungünstig in der Tabelle hinterlegt. Zu Beginn hatte ich den Ort und die Strasse und die Hausnummer separiert, da es so aussah das die in eigene Spalten untergebracht werden sollten. Aber das war schließlich ein zeitaufwendiger Trugschluß.
Die Berechnungen würde ich gar nicht in der case Konstruktion unterbringen sondern, weiter oben beim avntTemp. Darin ist der aktuellen Datensatz gespeichert.
Gruß
RB

Dim lngMonth As Long, ialngIndex As Long, lngRow As Long, lngColumn As Long, lngDauer As _ Long Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant For lngMonth = 1 To 2 'auf 12 Monate erhöhen!!! lngRow = 12 With Worksheets(MonthName(Month:=lngMonth)) Do If IsEmpty(.Cells(lngRow + 1, 26).Value) Then lngRow = .Cells(lngRow, 26).End(xlDown).Row Else lngRow = lngRow + 1 End If If lngRow lngDauer = DateDiff("d", .Cells(lngRow, "AA", "AD")) ReDim Preserve avntTemp(1 To 1, UBound(avntTemp, 2) + 1) avntTemp(1, 7) = .Cells(lngRow, "AE") - .Cells(lngRow, "AB").Value '.Text ' _ beispiel zelle (Dauer) avntTemp(1, 8) = .Cells(lngRow, 25).Value 'beispiel zelle (Kosten) For Each vntItem In avntTemp Select Case lngColumn Case 2, 5, 7 avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn") lngColumn = lngColumn + 1 If lngColumn = 5 Then If lngDauer > 0 Then avntValues(5, ialngIndex) = " _ 24:00" ElseIf lngColumn = 7 Then Select Case vntItem Case Is = TimeSerial(24, 0, 0) avntValues(8, ialngIndex) = "24,00 " avntValues(7, ialngIndex) = "24:00" Case Is > TimeSerial(8, 0, 0) avntValues(8, ialngIndex) = "12,00 " Case Else avntValues(8, ialngIndex) = "Fehler" Debug.Print vntItem End Select lngColumn = lngColumn + 1 End If Case Else avntValues(lngColumn, ialngIndex) = vntItem lngColumn = lngColumn + 1 End Select Next ialngIndex = ialngIndex + 1 Else Exit Do End If Loop End With Next lst_Dienstreise.Column = avntValues

Do If IsEmpty(.Cells(lngRow + 1, 26).Value) Then lngRow = .Cells(lngRow, 26).End(xlDown).Row Else lngRow = lngRow + 1 End If If lngRow = 24 Then avntValues(7, ialngIndex) = "24: _ 00" ElseIf lngColumn = 7 Then Select Case vntItem Case Is = TimeSerial(24, 0, 0) avntValues(8, ialngIndex) = "24,00 " avntValues(7, ialngIndex) = "24:00" Case Is > TimeSerial(8, 0, 0) avntValues(8, ialngIndex) = "12,00 " Case Else avntValues(8, ialngIndex) = "Fehler" Debug.Print vntItem End Select lngColumn = lngColumn + 1 End If Case Else avntValues(lngColumn, ialngIndex) = vntItem lngColumn = lngColumn + 1 End Select Next ialngIndex = ialngIndex + 1 Else Exit Do End If Loop

ReDim Preserve avntTemp(1 To 1, UBound(avntTemp, 2) + 1) avntTemp(1, 7) = .Cells(lngRow, "AE") - .Cells(lngRow, "AB").Value '(Dauer) _ avntTemp(1, 8) = lngDauer '.Cells(lngRow, "AL").Value ' (Kosten)

Hi ralf_b.
Deine Hinweise für einige Stellen im Code sind sehr hilfreich für mich gewesen.
Danke dafür.
Zu deinem letztem Absatz.
Die "flüchtigen" Werte brauche ich eigentlich nur temporär. Dies bedeutet, "Dauer" soll nur in der Liste angezeigt werden und zur Berechnung der nachfolgende Spalte zur Darstellung der Kosten. Und die Kosten sollen in Zukunft nur im UF in einem Label den Gesamtbetrag aller Zeilen in der ListBox anzeigen.
Ich möchte die schon vorhandenen ComboBoxen der UF als Filter nutzen und dann die Kosten gefiltert berechnen lassen. Das ist bis jetzt meine Idee.
An die zusätzlichen Spalten habe ich auch schon gedacht. Diel Lösung wäre sicherlich auch die bessere und einfachste. Zum Lernen mit VBA ist diese Version auch hilfreich.
Jetzt habe ich mit deiner Hilfe einiges lösen können,


Dim lngMonth As Long, ialngIndex As Long, lngRow As Long, lngColumn As Long, lngDauer As Long
Dim datBeginn As Date, datEnde As Date
Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant
For lngMonth = 1 To 2 'auf 12 Monate erhöhen!!!
lngRow = 12
With Worksheets(MonthName(Month:=lngMonth))
Do
If IsEmpty(.Cells(lngRow + 1, 26).Value) Then
lngRow = .Cells(lngRow, 26).End(xlDown).Row
Else
lngRow = lngRow + 1
End If
If lngRow datBeginn = CDate(.Cells(lngRow, "AA")) + CDate(.Cells(lngRow, "AB"))
datEnde = CDate(.Cells(lngRow, "AD")) + CDate(.Cells(lngRow, "AE"))
avntTemp = .Range(.Cells(lngRow, 26), .Cells(lngRow, 33)).Value  'Werte für  _
Spalten 1-8 aus Spalte 26 bis 32 Sheets(oder 38 für AL)
'lngDauer = DateDiff("h", .Cells(lngRow, "AA"), .Cells(lngRow, "AD"))
lngDauer = DateDiff("h", datBeginn, datEnde)
ReDim Preserve avntTemp(1 To 1, UBound(avntTemp, 2) + 1)    'Array  _
Spaltengröße erhöhen und 2 Spalten hinzufügen
avntTemp(1, 7) = .Cells(lngRow, "AE") - .Cells(lngRow, "AB").Value  '(Dauer) _
avntTemp(1, 8) = lngDauer   '.Cells(lngRow, "AL").Value  ' (Dauer  _
dezimal)
For Each vntItem In avntTemp
Select Case lngColumn
Case 2, 5, 7
avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn")
lngColumn = lngColumn + 1
If lngColumn = 8 Then
If lngDauer >= 24 Then avntValues(7, ialngIndex) = " _
24:00"
ElseIf lngColumn = 7 Then
Select Case vntItem
Case Is = TimeSerial(24, 0, 0)
avntValues(10, ialngIndex) = "24,00 "
'avntValues(7, 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
Case Else
avntValues(lngColumn, ialngIndex) = vntItem
lngColumn = lngColumn + 1
End Select
Next
ialngIndex = ialngIndex + 1
Else
Exit Do
End If
Loop
End With
Next
lst_Dienstreise.Column = avntValues

aber wie bekomme ich die weitere Spalte mit den Kosten in die Liste als letzte Spalte? Was schreibe ich nach



avntTemp(1,9) =

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

Do If IsEmpty(.Cells(lngRow + 1, 26).Value) Then lngRow = .Cells(lngRow, 26).End(xlDown).Row Else lngRow = lngRow + 1 End If If lngRow 24 dann Wert in Spalte 7 auf "24:00" If lngDauer >= 24 Then avntValues(7, ialngIndex) = "24:00" 'sonst wenn Spalte 7 ElseIf lngColumn = 7 Then 'dann Select Case vntItem Case Is = TimeSerial(24, 0, 0) avntValues(8, ialngIndex) = "24,00 " 'avntValues(7, ialngIndex) = "24:00" Case Is > TimeSerial(8, 0, 0) avntValues(8, ialngIndex) = "12,00 " Case Else avntValues(8, ialngIndex) = "Fehler" Debug.Print vntItem End Select lngColumn = lngColumn + 1 End If Case Else avntValues(lngColumn, ialngIndex) = vntItem lngColumn = lngColumn + 1 End Select Next ialngIndex = ialngIndex + 1 Else Exit Do End If Loop

ElseIf lngColumn = 7 Then 'sonst wenn bei Spalte 7 Select Case vntItem Case Is TimeSerial(8, 0, 0) If strBeginnOrt = "A" Or strEndeOrt = "A" Then avntValues(8, ialngIndex) = "27,00 " ElseIf strBeginnOrt = "I" Or strEndeOrt = "I" Then avntValues(8, ialngIndex) = "27,00 " Else avntValues(8, ialngIndex) = "14,00 " End If Case Is >= TimeSerial(24, 0, 0) If strBeginnOrt = "A" Or strEndeOrt = "A" Then avntValues(8, ialngIndex) = "40,00 " ElseIf strBeginnOrt = "I" Or strEndeOrt = "I" Then avntValues(8, ialngIndex) = "40,00 " Else avntValues(8, ialngIndex) = "28,00 " End If Case Else avntValues(8, ialngIndex) = "Fehler" Debug.Print vntItem End Select

'----------- ListBox mit Daten von allen Sheets füllen mit Hilfe von ralf_b von herber.de ------ _ Dim lngMonth As Long, ialngIndex As Long, lngRow As Long Dim lngColumn As Long, lngDauer As Long Dim datBeginn As Date, datEnde As Date, strBeginnOrt As String Dim strEndeOrt As String, strReiseOrt As String Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant For lngMonth = 1 To 2 'auf 12 Monate erhöhen!!! lngRow = 12 With Worksheets(MonthName(Month:=lngMonth)) Do If IsEmpty(.Cells(lngRow + 1, 26).Value) Then lngRow = .Cells(lngRow, 26).End(xlDown).Row Else lngRow = lngRow + 1 End If If lngRow 8 If strBeginnOrt = "A" Or strEndeOrt = "A" Then avntTemp(1, 8) = "27,00 " ElseIf strBeginnOrt = "I" Or strEndeOrt = "I" Then avntTemp(1, 8) = "27,00 " Else avntTemp(1, 8) = "14,00 " End If Case Is >= 24 If strBeginnOrt = "A" Or strEndeOrt = "A" Then avntTemp(1, 8) = "40,00 " ElseIf strBeginnOrt = "I" Or strEndeOrt = "I" Then avntTemp(1, 8) = "40,00 " Else avntTemp(1, 8) = "28,00 " End If Case Else avntTemp(1, 8) = "Fehler" Debug.Print vntItem End Select For Each vntItem In avntTemp Select Case lngColumn Case 2, 5, 7 avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn") lngColumn = lngColumn + 1 'Wenn Spalte 8 If lngColumn = 8 Then 'Wenn lngDauer > 24 dann Wert in Spalte 7 auf "24:00" If lngDauer >= 24 Then avntValues(7, ialngIndex) = "24:00" End If Case Else avntValues(lngColumn, ialngIndex) = vntItem lngColumn = lngColumn + 1 End Select Next ialngIndex = ialngIndex + 1 Else Exit Do End If Loop End With Next lst_Dienstreise.Column = avntValues '--------- Ende Füllen ListBox ----------------------------------------------------------------

Select Case lngColumn Case 2, 5, 7 avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn") lngColumn = lngColumn + 1 'Wenn Spalte 8 If lngColumn = 8 Then 'Wenn lngDauer > 24 dann Wert in Spalte 7 auf "24:00" If lngDauer >= 24 Then avntValues(7, ialngIndex) = "24:00" End If Case Else avntValues(lngColumn, ialngIndex) = vntItem lngColumn = lngColumn + 1 End Select

Select Case lngColumn Case 2, 5, 7 avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn") lngColumn = lngColumn + 1 'Wenn Spalte 9 ' Case 8 ' 'Wenn lngDauer > 24 dann Wert in Spalte 7 auf "24:00" ' 'If lngDauer >= 24 Then avntValues(8, ialngIndex) = "24:00" ' lngColumn = lngColumn + 1 Case Else avntValues(lngColumn, ialngIndex) = vntItem lngColumn = lngColumn + 1 End Select

Case Is >= 24 If strBeginnOrt = "A" Or strEndeOrt = "A" Then avntTemp(1, 8) = "40,00 " avntTemp(1, 7) = "24:00" ElseIf strBeginnOrt = "I" Or strEndeOrt = "I" Then avntTemp(1, 8) = "40,00 " avntTemp(1, 7) = "24:00" Else avntTemp(1, 8) = "28,00 " avntTemp(1, 7) = "24:00" End If

'----------- ListBox mit Daten von allen Sheets füllen mit Hilfe von ralf_b von herber.de ------ _ _ Dim lngMonth As Long, ialngIndex As Long, lngRow As Long Dim lngColumn As Long, lngDauer As Long Dim datBeginn As Date, datEnde As Date, strBeginnOrt As String Dim strEndeOrt As String, strReiseOrt As String Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant For lngMonth = 1 To 2 'auf 12 Monate erhöhen!!! lngRow = 12 With Worksheets(MonthName(Month:=lngMonth)) Do If ialngIndex = 4 Then MsgBox "x" If IsEmpty(.Cells(lngRow + 1, 26).Value) Then lngRow = .Cells(lngRow, 26).End(xlDown).Row Else lngRow = lngRow + 1 End If If lngRow = 24 If strBeginnOrt = "A" Or strEndeOrt = "A" Then avntTemp(1, 8) = "40,00 " ElseIf strBeginnOrt = "I" Or strEndeOrt = "I" Then avntTemp(1, 8) = "40,00 " Else avntTemp(1, 8) = "28,00 " End If Case Is > 8 If strBeginnOrt = "A" Or strEndeOrt = "A" Then avntTemp(1, 8) = "27,00 " ElseIf strBeginnOrt = "I" Or strEndeOrt = "I" Then avntTemp(1, 8) = "27,00 " Else avntTemp(1, 8) = "14,00 " End If Case Else avntTemp(1, 8) = "Fehler" Debug.Print vntItem End Select For Each vntItem In avntTemp Select Case lngColumn Case 2, 5, 7 avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn") lngColumn = lngColumn + 1 Case Else avntValues(lngColumn, ialngIndex) = vntItem lngColumn = lngColumn + 1 End Select Next ialngIndex = ialngIndex + 1 Else Exit Do End If Loop End With Next lst_Dienstreise.Column = avntValues '--------- Ende Füllen ListBox

Case Is >= 24 avntTemp(1, 7) = "24:00" If strBeginnOrt = "A" Or strEndeOrt = "A" Then avntTemp(1, 8) = "40,00 " ElseIf strBeginnOrt = "I" Or strEndeOrt = "I" Then avntTemp(1, 8) = "40,00 " Else avntTemp(1, 8) = "28,00 " End If

Beliebteste Forumthreads (12 Monate)

32
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Code erläutern

32 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

32
Beiträge zum Forumthread

Beiträge zu diesem Forumthread