11

VBAの配列に、特定の条件を満たす行のみの行番号を入力したいと思います。可能な限り最速の方法が欲しいです（たとえば、のようなものRowArray = index(valRange=valMatch).row）

以下は、（遅い）範囲ループのコードです。

Current Code

Sub get_row_numbers()

Dim RowArray() As Long
Dim valRange As Range
Dim valMatch As String

Set valRange = ActiveSheet.Range("A1:A11")
valMatch = "aa"
ReDim RowArray(WorksheetFunction.CountIf(valRange, valMatch) - 1)

For Each c In valRange
    If c.Value = valMatch Then RowArray(x) = c.Row: x = x + 1
Next c    
End Sub
4

8 に答える 8

12

それでも Chris の効率的なバリアント配列の約 2 ～ 3 倍の時間ですが、この手法は強力で、この問題を超えた用途があります。

注意すべき点の 1 つはApplication.Transpose、65536 セルに制限されているため、より長い範囲を「チャンク」する必要があることです。

Sub GetEm()
Dim x
x = Filter(Application.Transpose(Application.Evaluate("=IF(A1:A50000=""aa"",ROW(A1:a50000),""x"")")), "x", False)
End Sub
于 2012-10-25T03:29:14.630 に答える
8

最初に範囲をバリアント配列にコピーしてから、配列をループします

Arr = rngval
For I = 1 to ubound(arr)
    If arr(I,1) = valMatch Then RowArray(x) = I: x = x + 1
Next
于 2012-10-16T18:50:59.003 に答える
4

質問のタイトルには、ループ ソリューションは遅く、非ループ ソリューションは高速であるという仮定があります。ということで、比較して確認してみました。

テストケース

50,000 個のサンプルと 50% の一致値で構成されるサンプル データをいくつか作成しました。最速の方法として、さらに 2 つのサンプル セットを作成しました。これも 50,000 行で、1 つには 10% 一致する行があり、もう 1 つには 90% 一致する行があります。

投稿された各メソッドをこのデータに対してループで実行し、ロジックを 10 回繰り返しました (合計 500,000 行を処理するための時間です)。

                  50%        10%        90%  
ExactaBox        1300       1240       1350  ms
Scott Holtzman 415000         
John Bustos     12500       
Chris neilsen     310        310        310
Brettdj           970        970        970
OP               1530       1320       1700

したがって、教訓は明らかです。ループが含まれているからといって、遅くなることはありません。遅いのはワークシートへのアクセスなので、それを最小限に抑えるためにあらゆる努力をする必要があります。

更新 Brettdj のコメントのテストを追加: 1 行のコード

完全を期すために、ここに私の解決策があります

Sub GetRows()
    Dim valMatch As String
    Dim rData As Range
    Dim a() As Long, z As Variant
    Dim x As Long, i As Long
    Dim sCompare As String

    Set rData = Range("A1:A50000")
    z = rData
    ReDim a(1 To UBound(z, 1))
    x = 1
    sCompare = "aa"
    For i = 1 To UBound(z)
        If z(i, 1) = sCompare Then a(x) = i: x = x + 1
    Next
    ReDim Preserve a(1 To x - 1)    
End Sub
于 2012-10-24T10:11:57.930 に答える
3

他の人がここで提供したものを基に、両方の方法といくつかの文字列操作を組み合わせて、ループせずに目的の一致を含む任意の範囲の正確な行番号を取得しました。

コードと異なる唯一の注意点は、それRowArray()がString型であるということです。ただし、CLng必要に応じて、必要に応じて数値を削除して、Longに変換することもできます。

Sub get_row_numbers()

Dim rowArray() As String, valRange As Range, valMatch As String
Dim wks As Worksheet, I As Long, strAddress As String    
Set wks = Sheets(1)
valMatch = "aa"

With wks    
    Set valRange = .Range("A1:A11")        
    Dim strCol As String
    strCol = Split(valRange.Address, "$")(1)
    '-> capture the column name of the evaluated range
        '-> NB -> the method below will fail if a multi column range is selected

    With valRange        
        If Not .Find(valMatch) Is Nothing Then
        '-> make sure valMatch exists, otherwise SpecialCells method will fail

            .AutoFilter 1, valMatch                    
            Set valRange = .SpecialCells(xlCellTypeVisible)
            '-> choose only cells where ValMatch is found

            strAddress = valRange.Address '-> capture address of found cells
            strAddress = Replace(Replace(strAddress, ":", ""), ",", "") '-> remove any commas and colons
            strAddress = Replace(strAddress, "$" & strCol & "$", ",") '-> replace $column$ with comma
            strAddress = Right(strAddress, Len(strAddress) - 1) '-> remove leading comma

            rowArray() = Split(strAddress, ",")

            '-> test print
            For I = 0 To UBound(rowArray())                    
                Debug.Print rowArray(I)                        
            Next

        End If 'If Not .Find(valMatch) Is Nothing Then            
    End With ' With valRange        
End With 'With wks

End Sub
于 2012-10-22T17:50:39.053 に答える
2

Find vs Match vs Variant Arrayを見てみると、ヒット密度が非常に低い場合を除き、Variant Array アプローチが最速であると結論付けられます。

しかし、最速の方法は、並べ替えられたデータと完全一致の場合のみです。二分探索を使用して最初と最後のオカレンスを見つけ、そのデータのサブセットをバリアント配列に取得します。

于 2012-10-25T07:35:32.200 に答える
1

皆様、個別にご意見をお寄せいただきありがとうございます。

ExactaBox、あなたのソリューションは私にとって非常に役に立ちました。ただし、数式を介して 0 値を返すには問題があります。

rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)".

VBA フィルター関数は文字列比較を行うことによって値をフィルター処理するため、ゼロを含む行番号もフィルター処理します。たとえば、有効な行番号、20、30、40 などもゼロが含まれているため除外されるため、式の 0 の代わりに文字列を記述することをお勧めします。したがって、次のようになります。

rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),""Valid"")"

上記のbrettdjによっても提案されたように、最後の引数として「x」文字列を使用しました。

于 2013-06-27T09:57:05.803 に答える
1

この例では、範囲がハードコーディングされています。右側に予備の列はありますか? その場合、一致しない場合は右側のセルに 0 を入力し、一致する場合は行番号を入力します。次に、それを配列に取り込み、フィルタリングします。ループなし:

Sub NoLoop()

Dim valMatch As String
Dim rData As Excel.Range, rFormula As Excel.Range
Dim a As Variant, z As Variant

    Set rData = ThisWorkbook.Worksheets(1).Range("A1:A11") 'hard-coded in original example
    Set rFormula = ThisWorkbook.Worksheets(1).Range("B1:B11") ' I'm assuming this range is currently empty
    valMatch = "aa" 'hard-coded in original example

    'if it's a valid match, the cell will state its row number, otherwise 0
    rFormula.FormulaR1C1 = "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)"

    a = Application.Transpose(rFormula.Value)
    z = Filter(a, 0, False) 'filters out the zeroes, you're left with an array of valid row numbers

End Sub

1 次元配列を取得するための Application.Transpose トリックについては、Excel Range の 1 次元配列で Jon49 の功績を認めなければなりません。

于 2012-10-24T05:52:56.653 に答える
1

まだループがありますが、配列にデータを入力するために必要な行のみを通過します。

Sub get_row_numbers()

Dim RowArray() As Long
Dim valRange As Range
Dim valMatch As String

Set valRange = ActiveSheet.Range("A1:A11")
valMatch = "aa"
ReDim RowArray(WorksheetFunction.CountIf(valRange, valMatch) - 1)

Dim c As Range
Dim x As Integer
Set c = valRange.Find(What:=valMatch, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext)

Do
  RowArray(x) = c.Row
  Set c = valRange.FindNext(after:=c)
  x = x + 1
Loop Until x = UBound(RowArray) + 1


End Sub
于 2012-10-22T16:08:21.823 に答える