im Prinzip gibt es 12 unterschiedliche Namen und es sollen nur "Verbund1", "Halle1", "Team1, "Team2", "Mannschaft3", "Halle4", "Mannschaft9", "Klub3" übernommen werden. Ich hatte Verbund 1 bis 8 wegen der Einfachheit es hier u schildern genommen. Sorry, mein Versehen.
Bei mir kommt der Fehler "Index außerhalb des gültigen Bereichs"
Index außerhalb des gültigen Bereichs bedeutet, dass der abgefragte Index der Arrayzelle nicht in eine oder beide Dimensionen des Arrays passen und somit außerhalb der Dimension liegt.
Falls du es nicht schon gemacht hast öffne das Lokalfenster im VBA Editor und gehe via F8 die Prozedur soweit durch, bis das Array gefüllt ist. Dann schaue dir im Lokalfenster den Inhalt des Arrays an.
Es kennt keiner deine Originaltabellen. Da braucht es um vernünftig helfen zu können einfach klare Fehlerbeschreibungen.
Achte auch bei der Nutzung von Arrays darauf, wenn sich Formeln im Tabellenblatt befinden deren Werte im Array geladen werden, dass diese Formeln keine Fehlerausgabe in die Zelle schreiben.
So was kann auch zu Problemen via Resize führen.
Überdenke einfach mal in Ruhe was du wie haben möchtest und baue 2 Dateien 1 zu 1 (anonymisiert versteht sich) und lade diese Dateien hoch.
Den bisschen Kram dann vernünftig anpassen sollte kein Problem darstellen.
Was die Sache mit dem aktuellen Datum anlangt, wie willst du es handhaben? Nachts 23:59 Uhr die Datensätze einlesen um mit dem aktuellen Datum zu arbeiten oder besser einlesen ab Datum und Zeit bis Datum Zeit.
die Datei "Aussicht" hat immer die Daten bis in Zeile 6049. In der Datei wo die Werte eingetragen werden sollen sind ja schon Daten drin und so kommen am Ende 11904 Zeilen mit Werte zustande. Bestimmt liegt es dann außerhalb des Arrays.
Hier eine mit Power Query erstellte Lösung, die auch deine unvollständige Aufgabenstellung berücksichtigt, da bei dieser immer der Datumsbereich "Größer bisheriger Import und kleiner morgiges Datum" berücksichtigt wird.
Sowohl die Quelle, als auch die zu filternden Abnehmer kannst du in der Mappe pflegen.
Folgende(r) 1 Nutzer sagt Danke an ws-53 für diesen Beitrag:1 Nutzer sagt Danke an ws-53 für diesen Beitrag 28 • Olerostock
13.04.2025, 14:37 (Dieser Beitrag wurde zuletzt bearbeitet: 13.04.2025, 14:38 von Olerostock.)
Moin Egon,
ich habe jetzt den Code an meine Datei angeglichen und der Laufzeitfehler kommt bei der Funktion "DateiAuslesen"
Sub DateiLesen() Dim Datei$, Pfad$, lz1 As Long With ThisWorkbook.Sheets("Prognose") 'ggf. anpassen lz1 = .Cells(Rows.Count, 1).End(xlUp).Row If Cells(lz1, 1) = Date Then MsgBox "Die heutigen Daten sind bereits übertragen!", vbInformation Exit Sub End If End With
With ThisWorkbook.Sheets("Istzahlen") Pfad = .Range("A52").Value Datei = .Range("A51").Value If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\" Application.Workbooks.Open (Pfad & Datei) Application.ScreenUpdating = False arr = Workbooks(Datei).Sheets(1).UsedRange.Value Application.Workbooks(Datei).Close DatenAuslesen .Range("C4") = Date + Time Application.ScreenUpdating = True End With End Sub
Private Sub DatenAuslesen() Dim i&, j&, k&, arrList(), lz1 As Long ReDim arrList(LBound(arr) To UBound(arr), LBound(arr, 2) To UBound(arr, 2)) 'hier kommt der Laufzeitfehler For i = LBound(arr) To UBound(arr) If arr(i, 1) = Date And (arr(i, 4) = "Halle1" Or arr(i, 4) = "Team1" Or arr(i, 4) = "Team2" Or arr(i, 4) = "Mannschaft3" Or arr(i, 4) = "Halle4" Or arr(i, 4) = "Mannschaft9" Or arr(i, 4) = "Verbund1" Or arr(i, 4) = "Klub3") Then k = k + 1 For j = LBound(arr, 2) To UBound(arr, 2) arrList(k, j) = arr(i, j) Next j End If Next i '** neu eingefügt wegen Laufzeitfehler bei k=0 If k = 0 Then MsgBox "Keine Werte für heutiges Datum vorhanden!", vbInformation: Exit Sub With ThisWorkbook.Sheets("Prognose") lz1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(lz1, 1).Resize(k, UBound(arrList, 2)) = arrList End With End Sub
Bei der Auswertung Lokal
Ausdruck Wert Typ Modul2 i 0 Long j 0 Long k 0 Long arrList Variant() lz1 0 Long arr Leer Variant/empty
ich habe die Tabelle entsprechend benannt, aber bei Array bekomme ich weiterhin einen Laufzeitfehler mit Typen unverträglich.
Private Sub DatenAuslesen() Dim i&, j&, k&, arrList(), lz1 As Long ReDim arrList(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 6) To UBound(arr, 6)) For i = LBound(arr) To UBound(arr) If arr(i, 1) = Date And (arr(i, 4) = "BSD Team I" Or arr(i, 4) = "Bsd Team II" Or arr(i, 4) = "1&1 Technik_Blue_Belt" Or arr(i, 4) = "1&1 Technik_Black_Belt" Or arr(i, 4) = "Concierge_Blue_Belt" Or arr(i, 4) = "Concierge_Green_Belt" Or arr(i, 4) = "DE_1u1_RT_Mobile_1st" Or arr(i, 4) = "1&1 PRB Gesamt") Then k = k + 1 For j = LBound(arr, 6) To UBound(arr, 6) arrList(k, j) = arr(i, j) Next j End If Next i