Array finde Fehler nicht

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

i = 8 For Each zelle In Bereich If zelle.Height > 0 Then j = zelle.Row - 7 If zelle.Value Like "*g*" And Not zelle.Offset(0, -1).Value Like "*g*" Then x = zelle.Column With Sheets("Auswertung") .Cells(j, i).Value = ActiveSheet.Cells(6, x).Value End With arr(i - 7) = ActiveSheet.Cells(6, x).Value Debug.Print arr(i - 7) i = i + 1 x = 0 End If Next

Sub Arraytest() Dim arr(0 To 11, 1 To 2) As Variant Dim arr1(1 To 20) As Variant Dim x Dim i Dim k x = ActiveCell.Row On Error Resume Next arr(0, 1) = "" arr(0, 2) = "" For i = 1 To 11 arr(i, 1) = ActiveSheet.Cells(x, i).Value arr(i, 2) = ActiveSheet.Cells(2, i).Value Next k = 1 For i = 1 To UBound(arr) If arr(i, 1) = "g" And arr(i - 1, 1) "g" Then arr1(k) = arr(i, 2) k = k + 1 End If If arr(i, 1) = "g" And arr(i + 1, 1) "g" Then arr1(k) = arr(i, 2) k = k + 1 End If Next For i = 1 To UBound(arr1) ActiveSheet.Cells(i + 10, 1).Value = arr1(i) Next End Sub

Hallo Peter,
der Fehler mit der letzten Zeile/Spalte tritt auf, weil i + 1 größer ist Ubound(arr).
Das resultiert in einen Fehler. Da du per Anweisung
On Error Resume Next
vorgegeben hast, dass bei einem Fehler die nächste Zeile ausgeführt werden soll, wird trotzdem ein Wert ins Ergebnis-Array geschrieben.
Mit nachfolgenden Anpassungen sollte das Ganze dynamisch funktionieren und durch die zusätzliche Prüfung wird der Fehler vermieden.
Man könnte arr1 auch jedes mal neu dimensionieren, wenn ein weiterer Wert hinzugefügt werden soll. Das ist aber in der Summe langsamer als das Array einmal auf die mögliche max. Anzahl von Werten zu dimensionieren und am Schluß den nicht benutzen Teil des Arrays wieder abzuschneiden.
Gruß
Franz

Sub Arraytest()
Dim arr() As Variant
Dim arr1() As Variant
Dim x
Dim i
Dim k
Dim Spalte As Long
x = ActiveCell.Row
With ActiveSheet
'Anzahl Spalten in Tabelle in Zeile x / Zeilen im Array
Spalte = .Cells(x, .Columns.Count).End(xlToLeft).Column '11
'Alt-Daten im Ausgabebereich löschen
i = .Cells(11, 1).End(xlDown).Row
If i  "g" Then
arr1(k) = arr(i, 2)
k = k + 1
End If
If i  "g" Then
arr1(k) = arr(i, 2)
k = k + 1
End If
Else
If arr(i, 1) = "g" Then
arr1(k) = arr(i, 2)
k = k + 1
End If
End If
Next
'leeren Bereich des Arrays entfernen
ReDim Preserve arr1(1 To k - 1)
For i = 1 To UBound(arr1)
ActiveSheet.Cells(i + 10, 1).Value = arr1(i)
Next
'Daten-Arrays leeren - funktioniert nur bei dynamischen Arrays!!
Erase arr1, arr
End Sub

ReDim arr(0 To Spalte, 1 To 2) ReDim arr1(1 To Spalte * 2) 'hier entfernen arr(0, 1) = "" arr(0, 2) = "" For i = 5 To Spalte arr(i - 4, 1) = ActiveSheet.Cells(x, i).Value arr(i - 4, 2) = ActiveSheet.Cells(6, i).Value Next For j = 1 To 2 ReDim arr1(1 To Spalte * 2) 'hier einfügen

Beliebteste Forumthreads (12 Monate)

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread