ReDim Preserve 2Dが範囲外になる

Question

この関数は、rangeとrangeの2つのパラメータを取得し、一致する値とそのアドレスを持つ配列を返します。しかし

Function filter_range_value(rng As String, selected_value As String) As Variant 
    Dim cell As Range 
    Dim array_storage() As Variant 
    Dim element As Integer 

    element = 1 

    For Each cell In Range(rng) 
     If InStr(cell, selected_value) > 0 Then 
      ReDim Preserve array_storage(element, 1) 
      array_storage(element, 0) = cell 
      array_storage(element, 1) = cell.address 
      element = element + 1 
     End If 
    Next cell 

    filter_range_value = array_storage 
End Function 

Answer 1

（任意の値に一致していない）、それはReDim Preserveとの誤差を与え、配列が空の場合にも、それはエラーになりますが、私はあなたがVBA.CollectionやScripting.Dictionaryを使用することを示唆してもいいですか？これは配列よりも操作がはるかに簡単で、実行時に正しいサイズを割り当てることに心配する必要はありません。コレクション/ディクショナリのキーは範囲アドレスにすることができます。あなたの問題を解決するために

Answer 2

：

あなたが保存REDIMと2D配列の最初の次元を変更することはできません。

COUNTIF（）を使用して、必要な行数を確認します。

element = Application.WorksheetFunction.CountIf(rng, "*" & selected_value & "*") 
ReDim array_storage(1 To element, 1 To 2) 

---

その他の注意事項：

私はまた、私たちは、解析を行うために、VBAを強制する必要はありませんRangeなくStringにrngを変更しました。

=filter_range_value(A:A,"a") 

行番号Set rng = Intersect(rng, rng.Parent.UsedRange)は、連続した繰り返しを行わないことを保証します。これにより、rngの完全な列参照が可能になり、使用範囲内のものだけが反復されます。

現在、ケース固有の文字列を探しています。あなたがしたい場合には、特定の使用を小文字ない：

If InStr(1, cell, selected_value, vbTextCompare) > 0 Then 

defualtがケース固有ですvbBinaryCompareです。

---

Function filter_range_value(rng As Range, selected_value As String) As Variant 
Dim cell As Range 
Dim array_storage() As Variant 
Dim element As Long 
Set rng = Intersect(rng, rng.Parent.UsedRange) 
element = Application.WorksheetFunction.CountIf(rng, "*" & selected_value & "*") 
ReDim array_storage(1 To element, 1 To 2) 
element = 1 
For Each cell In rng 
    If InStr(1, cell, selected_value, vbTextCompare) > 0 Then 
     array_storage(element, 1) = cell 
     array_storage(element, 2) = cell.Address 
     element = element + 1 
    End If 
Next cell 
filter_range_value = array_storage 
End Function 

---