AW: Application.Goto(Reference: Erklärung
09.11.2020 18:28:09
max.kaffl@gmx.de
Hallo Peer,
ich habe es dir mal eingebaut:
' **********************************************************************
' Modul: frm_Dienstreisen Typ: Userform
' **********************************************************************
Option Explicit
Private mBaseArray As Variant
Private Sub btn_OK_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
'############### Variante 1 #####################################################################
'Dim lngMonth As Long, ialngIndex As Long, lngRow As Long, lngColumn As Long
'Dim avntValues() As Variant, avntTemp As Variant, vntItem As Variant
'Dim datReisezeit As Date
'
' 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 'letzte Zeile Beginn Spalte 4
' If lngRow < .Rows.Count Then
' ReDim Preserve avntValues(18, ialngIndex)
' lngColumn = 0
' avntTemp = .Range(.Cells(lngRow, 4), .Cells(lngRow, 18)).Value
'
' For Each vntItem In avntTemp
' Select Case lngColumn
' Case 2, 6, 9 'BeginnZeit, EndeZeit, Dauer
' avntValues(lngColumn, ialngIndex) = Format$(vntItem, "Hh:Nn")
' If lngColumn = 9 Then
' Select Case vntItem
' Case Is < TimeSerial(8, 0, 0)
' avntValues(9, ialngIndex) = "00,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
'############## Variante 2 ##########################################################################
'----------- 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
Dim datAbgabe As Date, datAnnahme As Date, datGezahlt As Date
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 < .Rows.Count Then
'Festlegung der Listenspalten (hier 8)
Redim Preserve avntValues(11, ialngIndex)
lngColumn = 0
datBeginn = CDate(.Cells(lngRow, "AA")) + CDate(.Cells(lngRow, "AB"))
datEnde = CDate(.Cells(lngRow, "AD")) + CDate(.Cells(lngRow, "AE"))
lngDauer = DateDiff("h", datBeginn, datEnde)
strBeginnOrt = Left(.Cells(lngRow, "AC"), 1)
strEndeOrt = Left(.Cells(lngRow, "AF"), 1)
datAbgabe = .Cells(lngRow, "AH").Value
datAnnahme = .Cells(lngRow, "AI").Value
'Werte für Spalten 1-8 aus Spalte 26 bis 32 Sheets(oder 38 für AL)
avntTemp = .Range(.Cells(lngRow, 26), .Cells(lngRow, 35)).Value
'Array Spaltengröße erhöhen und 2 Spalten hinzufügen
Redim Preserve avntTemp(1 To 1, UBound(avntTemp, 2) + 1)
avntTemp(1, 7) = .Cells(lngRow, "AE") - .Cells(lngRow, "AB").Value '(Dauer)
avntTemp(1, 9) = datAbgabe
avntTemp(1, 10) = ""
Select Case lngDauer
Case Is <= 8 'der Wert <= 8
avntTemp(1, 8) = "00,00 "
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
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
avntValues(11, ialngIndex) = MonthName(Month:=lngMonth) & "|" & CStr(lngRow) '******************************************
ialngIndex = ialngIndex + 1
Else
Exit Do
End If
Loop
End With
Next
lst_Dienstreise.Column = avntValues
'--------- Ende Füllen ListBox ---------------------------------------------------------------
'--------- ComboBox "Monat" mit Monatsnamen vom Sheet füllen ---------------------------------
Dim j As Integer
'cbx_FilterMonat.Clear
cbx_FilterMonat.AddItem "alle Monate"
For j = 1 To 2 'auf 12 Monate ändern
cbx_FilterMonat.AddItem Worksheets(j).name
Next j
cbx_FilterMonat.ListIndex = 0 'ersten Eintrag als Standard
'--------- ComboBox "Reisezweck" füllen --------------------------------------------------------
cbx_FilterZweck.AddItem "alle Reisezwecke"
cbx_FilterZweck.ListIndex = 0
'--------- ComboBox "offene Abrechungen" füllen ------------------------------------------------
cbx_FilterOffen.AddItem "keine"
cbx_FilterOffen.ListIndex = 0
End Sub
Private Sub lst_Dienstreise_Click()
' bei Klick wird der Datensatz in der Tabelle markiert (frm_Dienstreise auf Showmodal = False setzen)
Dim avntAddress As Variant
With lst_Dienstreise
avntAddress = Split(.List(.ListIndex, 11), "|")
If .List(.ListIndex, 9) > 0 And .List(.ListIndex, 10) <= 0 And .List(.ListIndex, 11) <= 0 Then
Me.lbl_Status = "eingereicht"
ElseIf .List(.ListIndex, 9) = 0 Then
Me.lbl_Status = "nicht eingereicht"
ElseIf .List(.ListIndex, 10) > 0 Then
Me.lbl_Status = "geprüft"
ElseIf .List(.ListIndex, 11) > 0 Then
Me.lbl_Status = "abgerechnet"
Else
Exit Sub
End If
' Select Case .List
' Case .ListIndex, 9 > 0: Me.lbl_Status = "eingereicht"
' Case .ListIndex, 9 = 0: Me.lbl_Status = "nicht eingereicht"
' Case .ListIndex, 10 > 0: Me.lbl_Status = "geprüft"
' Case .ListIndex, 11 > 0: Me.lbl_Status = "abgerechnet"
' End Select
End With
Call Application.GoTo(Reference:=Worksheets(avntAddress(0)).Cells(Clng(avntAddress(1)), 26))
End Sub
Gruß
Nepumuk