Datenfeld
20.02.2023 17:11:25
Siegfried
Ich möchte Daten über eine mehrere Schleifen in ein Datenfeld aufnehmen und nach dem Verlassen der Schleife damit weiterarbeiten. Wie muss ich das anstellen.
Bis hier hab e ich folgenden Code gebastelt:
Sub ZahlenTest_starten()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim n1 As Integer, n2 As Integer, n3 As Integer
Dim Durchgänge As Integer, Treffer As Integer
Dim Wiederholung As String
Dim ArrWiederholungen() As Variant
Dim RngZahl As range, RngPrüfbereich As range
Dim ArrZahlen() As Variant
Dim dteStart As Date, dteEnde As Date
Durchgänge = Frm_Test.Lbl_Durchgänge_Test.Caption
dteStart = Timer
' prüft das Vorkommen von Zahlen
ReDim ArrZahlen(0 To 9)
For n1 = 0 To 9
Treffer = 0
' durchläuft die relevanten Zahlenreihen
For n2 = 0 To Durchgänge - 1
Tabelle1.Activate
' definiert die zu prüfende Zahl
Set RngZahl = range("Zahlen.Gesamt").Offset( _
Frm_Test.Lbl_Startdatum_Zeile.Caption + 1 - range("Zahlen.Gesamt").Row + n2, 9)
' definiert den Prüfbereich
Set RngPrüfbereich = range(Cells(Frm_Test.Lbl_Startdatum_Zeile.Caption + 1 + n2, _
range("Zahlen.Gesamt").Column + 3), _
Cells(Frm_Test.Lbl_Startdatum_Zeile.Caption + 1 + n2, _
range("Zahlen.Gesamt").Column + 8))
If RngZahl = n1 Then
Treffer = Treffer + 1
Wiederholung = n2 + 1 & Chr(32)
For n3 = 1 To Len(Wiederholung)
ReDim Preserve ArrWiederholungen(0 To 9, 1 To Len(Wiederholung))
If Mid(Wiederholung, n3, 1) = Chr(32) Then
ArrWiederholungen(n1, 1) = n1
ArrWiederholungen(n1, 2) = Wiederholung
' diese Überprüfung bringt die gewünschten Ergebnisse
Debug.Print n1, n2, Wiederholung, ArrWiederholungen(n1, 2)
End If
Next n3
End If
Next n2
ArrZahlen(n1) = Treffer
Next n1
' hier soll mit den Einträgen aus dem Datenfeld "ArrWiederholungen" weitergearbeitet werden
' ich erhalte jedoch nur den letzten Wert
Frm_Test.Hide
dteEnde = Timer
Debug.Print "Zahlen Testdauer bei " & Durchgänge & " Durchgängen " _
& Format(dteEnde - dteStart, "0.00") & " sec"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub