Redim Preserve klappt nicht

Hallo noch einmal,
ich muss heute noch einmal um Hilfe bitten.
habe ein Makro in dem ich in ein Array werte schreibe.
Dieses Makro lasse ich beim Start dimensionieren.(um es nicht in jedem durchlauf erneut dimensionieren lassen muss.
Und am Ende wollte ich einen Redim Preserve machen aber es kommt immer ein Fehler ?
Darum bitte ich um Hilfe was mache ich Falsch ?
Hier ein teil meines Codes
With Datendatei.Worksheets(gew_sheet)
iRows = .Cells(Rows.Count, z).End(xlUp).Row
ReDim inNr(iRows, 1)
For X = 21 To iRows
If .Cells(X, z).Value > 0 Then
ii = ii + 1
inNr(ii, 0) = .Cells(X, z - 2).Value 'werte1
inNr(ii, 1) = .Cells(X, 1).Value 'werte2
End If
Next X
End With
' ReDim Preserve inNr(1, ii)
End If
'Userform ausblenden
'frm_Auswertung.Hide
'Ausgabe der Daten in Listbox auf Userform
frm_Auswertung.lb_fehlerhafte.Clear
Hier kommt der Fehler(Laufzeitfehler 9 Index auserhalb des gültigen Bereichs.
ReDim Preserve inNr(ii, 1)
vielen Dank für eure Hilfe noch einmal !

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

ja aber du hast doch gesagt das ich kein Dim vorher angeben darf? Sorry jetzt blick ich nicht mehr durch:)
Hier noch einmal mein kompletter Code.


Sub hole_daten()
Dim z As Integer 'Zähler für Schleife
Dim X As Integer 'Zähler für Schleife
Dim ii As Integer 'Zähler für Anzahl Werte in Array
Dim iRows
Dim gew_sheet
On Error Resume Next
If frm_Auswertung.opt_erst.Value = True Then gew_sheet = "erster"
If frm_Auswertung.opt_letzt.Value = True Then gew_sheet = "letzter"
' Spalte finden in der die benötigten Werte stehen(ob prüfung i.o oder nicht)
z = Application.Match("0 = i.O.", Datendatei.Worksheets(gew_sheet).Rows(19), 0)
On Error GoTo 0
If IsError(z) Or z = 0 Then
MsgBox ("Keine Gültige Datei gewählt - Bitte eine andere Datei wählen"), vbCritical, " _
abbruch"
Datendatei.Close False
Exit Sub
Else
ii = -1
With Datendatei.Worksheets(gew_sheet)
iRows = .Cells(Rows.Count, z).End(xlUp).Row
ReDim inNr(iRows, 1)
'ReDim Dat_inNr(iRows)
For X = 21 To iRows
If .Cells(X, z).Value > 0 Then
ii = ii + 1
inNr(ii, 0) = .Cells(X, z - 2).Value
inNr(ii, 1) = .Cells(X, 1).Value
'Dat_inNr(ii) = .Cells(X, z - 2)
End If
Next X
End With
End If
'Userform ausblenden
'frm_Auswertung.Hide
ThisWorkbook.Sheets("Daten").Cells.Delete
ThisWorkbook.Sheets("Daten").Columns(1).NumberFormat = "@"
'Ausgabe der Daten in Listbox auf Userform
frm_Auswertung.lb_fehlerhafte.Clear
'------------------------------------- HIER KOMMT DER FEHLER (Laufzeitfehler 9) ---------------- _
ReDim Preserve inNr(ii, 1)
frm_Auswertung.lb_fehlerhafte.List = inNr 'WorksheetFunction.Transpose(inNr) 'gefundene  _
Injektoren in Listbox eintragen
frm_Auswertung.lbl_stk.Caption = frm_Auswertung.lb_fehlerhafte.ListCount 'Anzahl gefundener  _
Injektoren auf Label anzeigen
'Ausgabe der Daten in Tabellenblatt Daten in dieser Datei
'ThisWorkbook.Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Resize(ii, 1) =  _
WorksheetFunction.Transpose(inNr)
Datendatei.Close False
End Sub

Danke noch einmal vielmals für deine Hilfe !!!
gruß Chris

'letzter Eintrag bleibt erhalten, 'da die Area nicht mehr neu Dimensioniert wird Sub Test2() Dim meArea() Dim a As Integer For a = 0 To 10 Redim meArea(a, 0) meArea(a, 0) = "Hallo" & a Next a For a = 0 To 10 Debug.Print meArea(a, 0) Next a End Sub

'hier wird der rechte Bereich der Area neu Dimentioniert 'Daten bleiben erhalten Sub Test1() Dim meArea() Dim a As Integer For a = 0 To 10 Redim Preserve meArea(0, a) meArea(0, a) = "Hallo" & a Next a For a = 0 To 10 Debug.Print meArea(0, a) Next a End Sub

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Redim Preserve klappt nicht

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread