Laufzeitfehler 1004 bei Arraybefüllung
25.11.2016 18:07:56
MaxD.
ich habe folgendes Projekt. Ich möchte eine Liste generieren, die aus der Kombination von zwei Positionen (Produkte und Fälligkeiten) besteht. Jedes in der Liste vorgegebene Produkt soll hierbei genau einmal mit den in der Liste vorgegebenen Fälligkeitsterminen kombiniert werden. Es gibt also insgesamt Produktanzahl mal Fälligkeitenanzahl mögliche Kombinationsvarianten. Da die Anzahl der Produkte und Fälligkeitstermine sich immer weiter erhöhen, wird die Liste sehr lang wird, weshalb sie über den Code aktualisiert werden soll.
Zusätzlich sollen noch Attribute zu den jeweiligen Produkten mitgegeben werden, welche aber für die Kombinationen keine Rolle spielen.
In der Mappe (https://www.herber.de/bbs/user/109723.xlsm) habe ich ein Sheet (Input) für die Basisdaten und ein Sheet (PivotSource) für die Ausgabe.
Folgenden Code habe ich geschrieben und in Modul 1 abgelegt:
______________________________________________________
Sub Variantenzusammenstellung()
Dim intProdAnz As Integer
Dim intFaellAnz As Integer
Dim lngVariaAnz As Long
Dim varProdArr As Variant
Dim varFaellArr As Variant
Dim intWdhAnz As Integer
Dim intCounter As Integer
ThisWorkbook.Worksheets("Input").Range("C4:D5").Calculate 'Durchrechnen
'Datenauf-/vorbereitung
intProdAnz = ThisWorkbook.Worksheets("Input").Range("C5").Value 'Anzahl Positionen "Produkt" _
zuweisen
intFaellAnz = ThisWorkbook.Worksheets("Input").Range("D5").Value 'Anzahl Positionen "Fä _
lligkeiten" zuweisen
lngVariaAnz = ThisWorkbook.Worksheets("Input").Range("C4").Value 'Anzahl Varianten zuweisen
varProdArr = ThisWorkbook.Worksheets("Input").Range(Cells(7, 3), Cells(7 + intProdAnz - 1, 8) _
_
_
_
_
).Value 'Produkt-Werte Array zuweisen
varFaellArr = ThisWorkbook.Worksheets("Input").Range(Cells(7, 4), Cells(7 + intFaellAnz - 1, _
_
_
_
4)) _
.Value 'Fälligkeits-Werte Array zuweisen
intCounter = 0 'intCounter auf Null setzen
'Datenausgabe
ThisWorkbook.Worksheets("PivotSource").Range(Cells(3, 2), Cells(Rows.Count, 7)).Value = "" ' _
Ausgabebereich leeren
Application.ScreenUpdating = False 'Ansichtsaktualisierung ausstellen
intWdhAnz = lngVariaAnz / intFaellAnz 'Wiederholungen "Fälligkeiten" ermitteln
Do Until intCounter = intWdhAnz 'Fälligkeiten x-mal (intWdhAnz) wiederholt in Spalte ausgeben
intCounter = intCounter + 1
ThisWorkbook.Worksheets("PivotSource").Range(Cells(3 + intFaellAnz * (intCounter - 1), 3), _
_
_
_
_
Cells(3 + intFaellAnz * intCounter - 1, 3)) = varFaellArr
Loop
intCounter = 0 'intCounter auf Null setzen
intWdhAnz = 0 'intWdhAnz auf Null setzen
Do Until intCounter = intProdAnz 'Produkte und Produktattribute nacheinander den Fälligkeiten _
_
_
_
_
zuordnen
intCounter = intCounter + 1
ThisWorkbook.Worksheets("PivotSource").Range(Cells(3 + intFaellAnz * (intCounter - 1), 2), _
_
_
_
_
Cells(3 + intFaellAnz * intCounter - 1, 2)) = varProdArr(1 + intCounter - 1, 1)
ThisWorkbook.Worksheets("PivotSource").Range(Cells(3 + intFaellAnz * (intCounter - 1), 4), _
_
_
_
_
Cells(3 + intFaellAnz * intCounter - 1, 4)) = varProdArr(1 + intCounter - 1, 3)
ThisWorkbook.Worksheets("PivotSource").Range(Cells(3 + intFaellAnz * (intCounter - 1), 5), _
_
_
_
_
Cells(3 + intFaellAnz * intCounter - 1, 5)) = varProdArr(1 + intCounter - 1, 4)
ThisWorkbook.Worksheets("PivotSource").Range(Cells(3 + intFaellAnz * (intCounter - 1), 6), _
_
_
_
_
Cells(3 + intFaellAnz * intCounter - 1, 6)) = varProdArr(1 + intCounter - 1, 5)
ThisWorkbook.Worksheets("PivotSource").Range(Cells(3 + intFaellAnz * (intCounter - 1), 7), _
_
_
_
_
Cells(3 + intFaellAnz * intCounter - 1, 7)) = varProdArr(1 + intCounter - 1, 6)
Loop
ThisWorkbook.Worksheets("PivotSource").Range(Cells(2, 2), Cells(2 + lngVariaAnz, 19)).Name = " _
_
_
_
_
Pivotdatenbasis" 'Namen für Ausgabebereich vergeben
Application.Calculate 'Durchrechnen
Application.ScreenUpdating = True 'Ansichtsaktualisierung einstellen
'Variablen zurücksetzen
intProdAnz = 0
intFaellAnz = 0
lngVariaAnz = 0
Erase varProdArr
Erase varFaellArr
intCounter = 0
'MsgBox intWdhAnz & intProdAnz & intFaellAnz & lngVariaAnz, , "Prüfung"
End Sub
______________________________________________________
Wenn ich den Code ausführen will, bleibt er bei der fettgedruckten Zeile (Datenbefüllung des 1. Arrays)hängen und wirft den Laufzeitfehler '1004' - Anwendungs- oder objektdefinierter Fehler - raus.
Ich habe bereits versucht, mir selber über diverse Foren zu helfen und bin langsam mit meinem Latein am Ende.
In meiner ursprünglichen Arbeits- und Testversion hatte ich alles (Ein- und Ausgabe, Code) in einem Tabellenblatt intergriert und es funktionierte. Erst nachdem ich Ein- und Ausgabe auf verschiedene Tabellenblätter gebracht habe und den Code in das Modul geschrieben habe, kam dieser Fehler hoch.
Was steckt dahinter? Kann mir jemand helfen?
Viele Grüße
Max