0

いくつかの番号を一緒に検索しようとしています (国営宝くじ)。毎回 5 つの列を調べなければならず、90 の数字があります。可能性は 1.2 1.3 1.4 ... 89.90 で、4005 の組み合わせがあります。アルゴリズムはうまく機能しますが、検索の時間を管理することは絶対に不可能です。研究をスピードアップする可能性はありますか？

amb = 2 ～ 4006 の場合

    primo = Foglio3.Cells(amb, 1)
    secondo = Foglio3.Cells(amb, 2)

    ritardo = 0

    For cont = 8618 To 2 Step -1

        est1 = Foglio2.Cells(cont, 2)
        est2 = Foglio2.Cells(cont, 3)
        est3 = Foglio2.Cells(cont, 4)
        est4 = Foglio2.Cells(cont, 5)
        est5 = Foglio2.Cells(cont, 6)

        If (primo = est1) Or (primo = est2) Or (primo = est3) Or (primo = est4) Or (primo = est5) Then
            If (secondo = est1) Or (secondo = est2) Or (secondo = est3) Or (secondo = est4) Or (secondo = est5) Then
                Foglio3.Cells(amb, 3) = ritardo     '3 = nazionale
                Exit For
            End If

        End If

        ritardo = ritardo + 1

    Next cont

Next amb
4

1 に答える 1

1

最初のステップは、各ループでシートと VBA の使用を停止することです。したがって、データを配列に格納してから、メモリ内配列を反復処理します。必要に応じて、シートのデータ タイプに合わせてバリアントを変更します。注: Foglio2 と Foglio3 の範囲参照は、データセットに合わせて変更する必要があります。

Dim foglio2() As Variant, foglio3() As Variant
Dim i As Double

Dim primo As Variant, secondo As Variant
Dim est1 As Variant, est As Variant, est3 As Variant, est4 As Variant, est5 As Variant

Dim resultArray() As Variant

foglio3 = Foglio3.Range("A2").CurrentRegion
foglio2 = Foglio2.Range("A2").CurrentRegion

For i = 2 To UBound(foglio2) ' maybe change to 4006?

    primo = foglio2(1, 1)
    secondo = foglio2(1, 2)

    ' change J to 8616?
    For j = UBound(foglio3) To 2 Step -1

        est1 = foglio3(j, 2)
        est2 = foglio3(j, 3)
        est3 = foglio3(j, 4)
        est4 = foglio3(j, 5)
        est5 = foglio3(j, 6)

        ReDim Preserve resultArray(i)
        If (primo = est1) Or (primo = est2) Or (primo = est3) Or (primo = est4) Or (primo = est5) Then
            If (secondo = est1) Or (secondo = est2) Or (secondo = est3) Or (secondo = est4) Or (secondo = est5) Then

                resultArray(i) = ritardo     '3 = nazionale
                Exit For
            End If

        Else
            resultArray(i) = vbNullString
        End If

        ritardo = ritardo + 1


    Next j

Next i

Foglio3.Cells(2, 3).Resize(UBound(resultArray), 1) = resultArray
于 2012-11-30T11:26:28.630 に答える