检查项目是否存在于VBA中的Application.Match集合中 [英] Check If Item Exists in Collection with Application.Match in VBA

问题描述

我为Excel编写的宏代码有问题.

它与方法 Application.Match 或 Application.WorksheetFunction.Match

特别相关

我有一个字符串数组，用于在列表中存储所有公司的名称

  Dim CompanyID()作为字符串ReDim CompanyID(NumCO)对于i = 1到NumCOCompanyID(i)=工作表("Sheet1").Cells(i，1).Value接下来我 

然后我创建一个集合，使其仅包含所有不同的公司

  Dim DifCO作为新收藏，一个关于错误继续对于每个In CompanyIDDifCO.添加a，a下一个 

在我的代码后面，我再次浏览了公司，将它们与某些属性相关联，为此，我需要将公司保存在集合 DifCO 中的位置的索引.但是我无法通过 Application.Match

来获取它

我的程序似乎没有在那一行中做任何事情，并且为了证明这一点，我尝试在 MsgBox 中打印索引，但没有出现 MsgBox ，并且它甚至不会发送错误消息.

 对于我到NumCOMsgBox(Application.WorksheetFunction.Match(CompanyID(i)，DifCO，0))接下来我 

我尝试了不同的操作，例如使用 Application.Match 并将Collection的元素移动到另一个字符串的数组，但是结果是相同的.

我知道代码正确循环，因为在逐步调试选项中已经观察到了.但是我对可能是什么问题的想法已经用尽，所以我在这里问这个社区.

解决方案

正如Mat在OP上的注释中指出的那样，看来您使用了 On Error Resume Next 而没有 On ErrorGoTo 0 ，因此处理程序吞下了该错误，并且您没有看到它，并且未显示MsgBox.

在调试时，有一个在所有错误中中断的选项可能很有用，尽管在非常复杂的应用程序中这是很痛苦的，但对于这样的事情，它会标记为问题马上给你.在VBE中的工具">选项">常规"下:

通常您要避免 Resume Next ，除了非常小的和有目的的错误陷阱.像这样使它保持打开状态势必会进一步导致代码中的错误，进而导致难以解决的错误(如您所知！).

对于您的解决方案，您可以使用 ArrayList

 将昏暗列表作为对象设置列表= CreateObject("System.Collections.ArrayList")对于每个In CompanyID如果不是list.Contains(a)然后list.Add(a)下一个 

然后，通过使用 ToArray 方法将 ArrayList 转储到变量数组中，然后使用 Application.Match 对其进行测试来获取索引.:

  Dim arr，发现于arr = list.ToArray()对于i = 1到NumCOfoundAt = Application.Match(CompanyID(i)，arr，0)如果不是IsError(foundAt)，则发现MsgBox万一接下来我 

否则，从集合或数组中获取索引的通常方法就是对项目进行蛮力迭代，并且最好最好是分解一个临时函数来完成这些事情，而不要弄乱主要过程带有额外的循环:

  Sub collExample()昏暗的新收藏c.添加"9"c.添加"14"c.添加"3"c.添加"15"c.添加"4"c.添加"3"Debug.Print colItmExists(c，"5")'~~>错误的Debug.Print colItmExists(c，"10")'~~>真的Debug.Print colItmFirstIndex(c，"3")'~~>3Debug.Print colItmFirstIndex(c，"17")'~~>-1结束子函数colItmExists(col As Collection，itm)作为布尔值Dim i，ret为布尔值对于i = 1要计数如果col(i)= itm然后ret =真退出万一下一个colItmExists = ret结束功能函数colItmFirstIndex(col As Collection，itm)长暗淡如久如果不是colItmExists(col，itm)，则ret = -1别的对于i = 1要计数如果col(i)= itm然后ret =我退出万一下一个万一colItmFirstIndex = ret结束功能 

I have a problem with my code for a Macro I am writing for Excel.

It specifically relates to the Method Application.Match or alternatively Application.WorksheetFunction.Match

I have an array of strings where I store the names of all companies in a list

Dim CompanyID() As String
ReDim CompanyID(NumCO)


For i = 1 To NumCO
    CompanyID(i) = Worksheets("Sheet1").Cells(i, 1).Value
Next i

Then I creat a Collection to only contain all different companies

Dim DifCO As New Collection, a

On Error Resume Next
For Each a In CompanyID
    DifCO.Add a, a
Next

Later in my code I run through the companies again to relate them with certain properties, for which I need the Index of where the company is saved in the Collection DifCO. However I haven't been able to get it with Application.Match

My program does not seem to do anything in that line and to prove it I have tried to print the Index in a MsgBox but the MsgBox doesn't appear and it doesn't even sends an error message.

For i to NumCO
    MsgBox (Application.WorksheetFunction.Match(CompanyID(i), DifCO, 0))
Next i

I have tried different things as using Application.Match and moving the elements of the Collection to another string's array but the result is the same.

I know the code loops correctly since I have observed it in the step by step debugging option. But I have ran out of ideas on what could be the problem so here I am asking this community.

解决方案

As Mat indicates in comments on the OP, it looks like you've used On Error Resume Next without On Error GoTo 0, so the handler is swallowing the error and you're not seeing it, and the MsgBox is not displayed.

When debugging, there is an option to Break on All Errors which can be useful, although it's rather a pain in the ass in very complicated applications, for something like this it would've flagged the problem for you immediately. In the VBE under Tools > Options > General:

Generally you want to avoid Resume Next except for very small and purposeful error traps. Leaving it open like that is bound to cause errors further in your code which are then difficult to troubleshoot (as you've noticed!).

For your solution, you may use an ArrayList

Dim list as Object
Set list = CreateObject("System.Collections.ArrayList")

For Each a In CompanyID
    If Not list.Contains(a) Then list.Add(a)
Next

Then, get the index by dumping the ArrayList to a variant array using the ToArray method, and then testing that with Application.Match:

Dim arr, foundAt
arr = list.ToArray()

For i = 1 To NumCO
    foundAt = Application.Match(CompanyID(i), arr, 0) 
    If Not IsError(foundAt) Then
       MsgBox foundAt
    End If
Next i

Otherwise the usual method of getting index from a collection or an array is simply brute-force iteration over the items, and it's probably best to just spin off an ad-hoc function to do these things, rather than cluttering the main procedures with extra loops:

Sub collExample()
Dim c As New Collection
c.Add "9"
c.Add "14"
c.Add "3"
c.Add "15"
c.Add "4"
c.Add "3"

Debug.Print colItmExists(c, "5")        '~~> False
Debug.Print colItmExists(c, "10")       '~~> True
Debug.Print colItmFirstIndex(c, "3")    '~~> 3
Debug.Print colItmFirstIndex(c, "17")    '~~> -1

End Sub

Function colItmExists(col As Collection, itm) As Boolean
    Dim i, ret As Boolean
    For i = 1 To col.Count
        If col(i) = itm Then
            ret = True
            Exit For
        End If
    Next
    colItmExists = ret
End Function
Function colItmFirstIndex(col As Collection, itm) As Long
    Dim ret As Long
    If Not colItmExists(col, itm) Then
        ret = -1
    Else
        For i = 1 To col.Count
            If col(i) = itm Then
                ret = i
                Exit For
            End If
        Next
    End If
    colItmFirstIndex = ret
End Function

这篇关于检查项目是否存在于VBA中的Application.Match集合中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！