ich komme bei meiner Ermittlung der frühesten Startzeit einfach nicht mehr weiter und hoffe, dass ihr mir helfen könnt.
Ziel ist es, aus der Tabelle 1 die früheste Startzeit für jedes Datum des Monats zu ermitteln. Dazu stehen in Tabelle 2 in den Spaltenüberschriften die Fahrer-ID's und in den Zeilen die Tage des Monats. Nun sollen für jeden Fahrer und für jedes Datum die Startzeiten in einer Collection gesammelt werden. Diese wird dann in ein Array umgewandelt und es soll das Minimum - also die früheste Startzeit für das betreffende Datum in die betreffende Zelle in Tabelle 2 geschrieben werden.
Mein Code sieht derzeit so aus:
Sub Earliest_Start_ermitteln() 'Frühesten Start in einer Collection sammeln und das Minimum aus _
Array weitergeben.
Sheets("Tabelle1").Select 'Start der Prozedur aus Tabelle 1.
Dim a As Long
Dim b As Long
Dim col As New Collection 'Erstellen einer Datensammlung
Dim x As Variant
Dim y As Variant
For x = 2 To Sheets("Tabelle2").Cells(1, Columns.Count).End(xlToLeft).Column 'Schleife zum _
Abarbeiten der Benutzer (Fahrer-ID).
For y = 2 To Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row 'Schleife zum Abarbeiten des _
Datums.
a = Cells(Rows.Count, 5).End(xlUp).Row 'Anzahl der vom VEHCO zur Auswertung importierten _
Zeilen.
For b = 2 To a
'Vergleiche die Fahrer-ID's aus Tabelle 2 (Spaltenüberschriften) mit den in Tabelle 1 _
importierten Benutzer-ID's.
'Vergleiche das Datum aus Tabelle 2 mit den Datumswerten der aufgezeichneten Zeitstempel.
'Prüfe, ob in Tabelle 1, Spalte 3 das Ereignis "Start" ist.
'Treffen alle diese Bedingungen zu, schreibe die aufgezeichnete Uhrzeit in die _
Datensammlung.
If Cells(b, 5).Value = Tabelle2.Cells(1, x).Value And Cells(b, 10).Value = Tabelle2.Cells(y, _
1).Value And Cells(b, 3).Value = "Start" Then
col.Add (Cells(b, 11).Value)
Else
End If
Next
'Erstellen eines Arrays und Umwandlung der Datensammlung (col) in das Array.
Dim arr() As Variant
arr = toArray(col) 'Umwandeln der Collection in ein Array.
Sheets("Tabelle2").Cells(y, x) = Application.WorksheetFunction.Min(arr) 'Ermitteln des Minimums _
und ausgeben in die betreffenden Zielzellen.
Next
Next
End Sub
Function toArray(col As Collection)
Dim arr() As Variant
ReDim arr(0 To col.Count - 1) As Variant
For i = 1 To col.Count
arr(i - 1) = col(i)
Next
toArray = arr
End Function
Irgendwie schreibt er mir dann ab einer bestimmten Zelle immer den gleichen Wert hin. Ich denke, dass die Collection nicht erneuert wird und dann immer dasselbe Minimum aus dem Array gezogen wird. Brauche ich dazu noch eine Schleife, um immer eine neue Collection zu erzeugen und in ein neues Array umzuwandeln? Wenn ja, bitte um Hilfe, da ich nicht mehr weiter komme.
Ich würde mich über Hilfe sehr freuen.
Vielen lieben Dank und schöne Grüße,
Gottfried