IsInArray Excel VBA …超出范围

我试图创build一个数组通过循环在Excel中的列。 如果一个项目已经在数组中，那么我希望代码跳到列的下一个元素。

例如，当item1第二次到达数组时，它将被跳过，因为它已经在那里了

这是迄今为止的代码：

Sub productKey() ' ' productKey Macro Dim celltxt As String 'each column element Dim ListofProducts() As String 'declaration of array For i = 1 To 6 celltxt = ActiveSheet.Range("A" & i) 'grabs cell from column A If IsInArray(celltxt, ListofProducts) Then GoTo NextIteration Else ReDim Preserve ListofProducts(i) 'expands the array while preserving existing elements ListofProducts(i) = celltxt 'assigns elements that aren't in the array to the array End If productIndex = Application.Match(celltxt, ListofProducts, False) 'gives the location of the cell in the array ActiveSheet.Range("B" & i) = productIndex 'then assigns it to column B NextIteration: Next i End Sub Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End Function 

我得到以下：下标超出范围，然后与debugging错误本地化isinarray函数。

Answer 1

使用Scripting.Dictionary 。 字典对象由数据对组成; 一个唯一的键和一个相关的项目 。

Exists.Method可以testing字典的唯一键中是否存在产品。

 Sub productKey() ' productKey Macro Dim a As Long, dPRODs As Object, arr As Variant Set dPRODs = CreateObject("Scripting.Dictionary") With Worksheets("Sheet1") 'all of columns A & B into an array arr = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp)).Value2 End With 'populate the dictionary For a = LBound(arr, 1) To UBound(arr, 1) If Not dPRODs.exists(arr(a, 1)) Then _ dPRODs.Add Key:=arr(a, 1), Item:=arr(a, 2) Next a 'get then out of the dictionary For Each arr In dPRODs.Keys Debug.Print arr & " - " & dPRODs.Item(arr) Next arr 'transfer then to an array arr = dPRODs.Keys For a = LBound(arr) To UBound(arr) Debug.Print arr(a) Next a arr = dPRODs.Items For a = LBound(arr) To UBound(arr) Debug.Print arr(a) Next a End Sub 

对Exists进行testing意味着您将从第一次出现密钥时结束该项目。 可以调整代码以接受最后一次出现密钥的文本。

Answer 2

您的原始代码试图在声明时立即使用string数组，而不分配任何内容。

 Sub productKey2() ' productKey Macro Dim celltxt As String, i As Long, productIndex As Variant 'declaration and instantiation of array Dim ListofProducts() As String ReDim ListofProducts(i) '<~~ give it something to work with For i = 1 To 6 celltxt = ActiveSheet.Range("A" & i) 'grabs cell from column A If IsInArray(celltxt, ListofProducts) Then GoTo NextIteration Else ReDim Preserve ListofProducts(i) 'expands the array while preserving existing elements ListofProducts(i) = celltxt 'assigns elements that aren't in the array to the array End If productIndex = Application.Match(celltxt, ListofProducts, False) 'gives the location of the cell in the array ActiveSheet.Range("B" & i) = productIndex 'then assigns it to column B NextIteration: Next i End Sub Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End Function