ReDim保留二維超出範圍

Question

此函數獲取兩個參數一個範圍和一個值以匹配內部範圍，然後返回一個數組與匹配值和他們的地址。但它給出了ReDim Preserve錯誤，也當數組是空的（不匹配任何值）提示錯誤

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

我建議你使用VBA.Collection或Scripting.Dictionary？這比使用數組要容易得多，而且您無需關心在運行時分配正確的大小。收集/字典的關鍵可以是範圍地址。

Answer 2

解決您的問題：

你不能用REDIM改變第一維的二維數組保存。

使用COUNTIF（）查找所需的正確行數。

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

---

其他說明：

我也改變了rng到Range而不是String所以我們並不需要強制VBA做解析。

=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 

---