IsInArray Excel VBA ...超出范围 [英] IsInArray Excel VBA ...out of range

问题描述

我正在尝试通过遍历excel中的一列来创建数组。如果数组中已经有一个项目，那么我希望代码跳到该列的下一个元素。

I'm trying to create an array by looping through a column in excel. If an item is already in the array, then I want the code to skip to the next element of the column.

因此，例如，当第二次到达数组中的item1时，由于它已经存在而将被跳过

So for instance, when item1 is reached in the array for the second time, it would be skipped since it's already there

这是我到目前为止的代码：

This is the code I have so far:

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

我得到以下信息：下标超出范围，然后由于调试错误而定位到 isinarray 函数。

I get the following: subscript out of range and then with debugging error is localized to the isinarray function.

推荐答案

使用 Scripting.Dictionary 。字典对象由成对的数据组成。唯一的密钥和关联的项目。

Use a Scripting.Dictionary. A dictionary object consists of pairs of data; a unique key and an associated item.

Exists.Method 可以测试以查看字典的唯一键中是否已经存在产品。 / p>

The Exists.Method can test to see if a product already exists in the dictionary's unique keys.

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

测试是否存在意味着您将从键的第一次出现开始获得该项目。可以对代码进行调整，以接受最后一次出现的Key文本。

Testing for Exists means that you will end up with the Item from the first occurrence of the Key. The code can be adjusted to accept the text from the last occurrence of the Key.

这篇关于IsInArray Excel VBA ...超出范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！