Laufzeitfehler 06 Überlauf
05.03.2009 12:13:16
Susanne
Hallo,
habe von euch vor längerer Zeit Unterstützung bei einem Verdichtungsjob bekommen.
In Spalte A habe ich meine Auftragsnummer die in Einzelsätzen vorkommt. In Spalte B befindet sich der dazugehörige Betrag. Verdichtet wird auf die Auftragsnummer. Hat bis jetzt mit dem Makro unten super funktioniert. Seit heute aber leider nicht mehr. Er bringt mir "Laufzeitfehler 6" und "Überlauf". Die EIngabedatei beinhaltet 35.254 Datensätze. Beim Debuggen markiert er mir folgende Zeile:
iZiel = Range("A65536").End(xlUp).Row ' Letzte gefüllte Zelle ermitteln (in Spalte A)
Lösche ich alle Datensätze die in Spalte A leer sind manuell, so läuft das Makro ohne Probleme!
Wo liegt der Fehler? (die EIngabedateien sehen normal aus)
im voraus bereits vielen Dank für eure Hilfe!
Liebe Grüße
Susanne
Option Explicit
Sub Rohdaten_Innenaufträge()
' verdichtet in einer unsortierten Liste auf den Begriff in Spalte A
'Variablen deklarieren
Dim iZiel As Integer ' Letzte gefüllte Zelle
Dim az As Integer ' Zähler für Arrayfelder
Dim i As Integer ' Schleifenzähler (Arrays füllen)
Dim t As Integer ' Schleifenzähler (Gesamtpreise und Gesamtanzahl _
ermitteln)
Dim arr() As Variant ' Array für Artikelausgabe
Dim arr2() As Variant ' Array für Einzelpreisausgabe
iZiel = Range("A65536").End(xlUp).Row ' Letzte gefüllte Zelle ermitteln (in Spalte A)
' Arrays dimensionieren
ReDim arr(iZiel, 0) ' Artikel
ReDim arr2(iZiel, 0) ' Einzelpreise
'Leere Zellen filtern und löschen
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="="
Selection.Delete Shift:=xlUp
' Innenauftragsnummer aufbereiten
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(4, 1)), TrailingMinusNumbers:=True
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
'Leerzeile einfügen
Rows("1:1").Select
Selection.Insert Shift:=xlDown
' Arrays mit Werten füllen
For i = 2 To UBound(arr) ' laufe von Zeile 2 bis _
_
_
_
_
_
Tabellenende
If Application.WorksheetFunction.CountIf(Range(Cells(i, 1), _
Cells(1, 1)), Cells(i, 1).Value) = 1 Then ' wenn Artikel das _
erste Mal vorkommt, dann ...
arr(az, 0) = Cells(i, 1).Value ' ... Name in Array _
einlesen
az = az + 1 ' ... Zähler für _
Arrayfeld plus 1
End If ' Ende der Auswertung
Next i ' Schleifenzähler plus _
_
_
_
_
_
1
' Inhalte ausgeben
Range("E2", "E" & UBound(arr)) = arr ' Artikelnamen in _
Ausgabebereich schreiben
With Range("F2", "F" & UBound(arr)) ' Ausgabbereich für _
Beträge
.NumberFormat = "#,##0.00" ' Währungsformat _
festlegen
End With ' Ende des Eintrags
For t = 2 To az + 1 ' laufe von Zeile 2 bis _
_
_
_
_
_
Listenende
Cells(t, 6) = Application.WorksheetFunction.SumIf(Range(Cells(iZiel _
, 1), Cells(2, 1)), Cells(t, 5), Range("B2", "B" & iZiel)) ' Gesamtmenge berechnen
Next t ' Schleifenzähler plus _
_
_
_
_
_
1
Columns("E:F").EntireColumn.AutoFit ' Spalten auf optimale _
_
_
_
_
_
Breite
Rows("1:1").Select
Selection.Delete Shift:=xlUp
End Sub