Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1580to1584
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ermitteln und Ausgeben des Minimums

Ermitteln und Ausgeben des Minimums
14.09.2017 16:11:10
Gottfried
Hallo liebe Excel-Profis,
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ermitteln und Ausgeben des Minimums
16.09.2017 11:40:59
fcs
Hallo Gottfried,
du benötigts keine zusätzliche Schleife zum zurücksetzen der Collection. Das geht innerhalb der Schleife, die die Datumswerte abarbeitet/vergleicht. Zusätzlich muss man prüfen, ob die Collection Werte enthält, da sonst die Erstellung des Arrayy einen Fehler liefert.
Die Auswertung nach Start, Fahrer-ID, Datum und Minimum Uhrzeit am Datum könnte man aber auch sehr schön in einem Pivot-Tabellenbericht machen.
Gruß
Franz
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 Collection 'Erstellen einer Datensammlung    '##### geänderte Zeile #####
Dim x As Variant
Dim y As Variant
'Schleife zum Abarbeiten der Benutzer (Fahrer-ID).
For x = 2 To Sheets("Tabelle2").Cells(1, Columns.Count).End(xlToLeft).Column
'Schleife zum Abarbeiten des Datums.
For y = 2 To Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
Set col = New Collection                       '##### neue Zeile #####
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 b
'Erstellen eines Arrays und Umwandlung der Datensammlung (col) in das Array.
If col.Count > 0 Then                       '##### neue Zeile #####
Dim arr() As Variant
arr = toArray(col) 'Umwandeln der Collection in ein Array.
'Ermitteln des Minimums und ausgeben in die betreffenden Zielzellen.
Sheets("Tabelle2").Cells(y, x) = Application.WorksheetFunction.Min(arr)
End If                                      '##### neue Zeile #####
Set col = Nothing                           '##### neue Zeile #####
Next y
Next x
End Sub
Function toArray(col As Collection)
Dim arr() As Variant
Dim i As Long
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

Anzeige
AW: Ermitteln und Ausgeben des Minimums
21.09.2017 10:10:06
Gottfried
Hallo Franz,
vielen Dank für die sehr hilfreichen Informationen und die sehr kompetente Hilfestellung.
Deine Prozedur funktioniert einwandfrei.
Vielen herzlichen Dank und schöne Grüße,
Gottfried

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige