VBA: как мне искать в коллекции? - PullRequest
Новая
       19

VBA: как мне искать в коллекции?

3 голосов
/ 27 августа 2010

Я ищу определенный элемент в коллекции. как узнать, существует ли он в коллекции?

Ответы [ 5 ]

7 голосов
/ 27 августа 2010

Коллекция на основе индекса. Следовательно, вам придется перебирать коллекцию для поиска предмета. 

Sub test()
Dim iCtr As Integer
Dim itemCount As Integer

Dim myData As Collection
Set myData = New Collection

Dim searchFor As String

myData.Add "MS", "11"
myData.Add "Oracle", "22"
myData.Add "Google", "33"

'** Searching based on value
searchFor = "Google"

itemCount = myData.Count
For iCtr = 1 To itemCount
    If myData(iCtr) = searchFor Then
        MsgBox myData(iCtr)
        Exit For
    End If
Next

'** Searching by key
MsgBox myData.Item("22")
End Sub
7 голосов
/ 27 августа 2010

Если вы использовали ключ при добавлении элемента в коллекцию, посмотрите, если ссылка на этот ключ выдает ошибку: 

on error goto no_item
col.Item "key"
msgbox "Item exists"

exit sub

no_item:    
msgbox "Item does not exist"

В противном случае вам придется пройтись по всем элементам, чтобы увидеть, есть литебе нужно.

3 голосов
/ 09 октября 2013

Я использую простую инструментальную функцию, которая перебирает коллекцию.Он не имеет прямого доступа к индексам и использует такие возможности языка VBA, как они должны использоваться (сравнение вариантов и каждый -Coop). 

Public Function ExistsIn(item As Variant, lots As Collection) As Boolean
    Dim e As Variant
    ExistsIn = False
    For Each e In lots
        If item = e Then
            ExistsIn = True
            Exit For
        End If
    Next
End Function
2 голосов
/ 13 января 2014

@ Josua Schmid:

Я думаю, что код в вашем ответе может быть правильным, но может быть и неправильным.Ваша функция имеет параметр типа Variant, который затем сравнивается с каждым пользователем коллекции.Но что сравнивается на самом деле?В этом случае сравнивается элемент по умолчанию.Таким образом, первая проблема может возникнуть, если коллекция будет содержать элементы некоторого пользовательского класса, для которого не задан элемент по умолчанию.В этом случае объект ошибки 438 во время выполнения не поддерживает это свойство или метод будет вызван.Можно добавить элемент по умолчанию, но даже тогда он будет работать не так, как вам кажется, я боюсь.

Пример с диапазонами (для Range-Class Value - элемент по умолчанию, поэтому значения сравниваются).Может быть, это именно то, что вы хотели, но, возможно, нет.Поэтому, с моей точки зрения, лучше использовать «Ключ» для каждого элемента, добавленного в коллекцию, а затем попытаться получить этот элемент по его ключу.

Debug.Print col.item (r1.Address)'Значение A1

Или по индексу, если ключи не использовались:

Debug.Print col.item (1)' Значение A1 

Sub test()
    Dim col As New VBA.Collection

    Dim r1 As Range
    Dim r2 As Range
    Dim r3 As Range

    Set r1 = Range("a1")
    Set r2 = Range("b1")
    Set r3 = Range("c1")

    r1 = "A1 Value"
    r2 = "B1 Value"
    r3 = "C1 Value"

    col.Add r1, r1.Address
    col.Add r2, r2.Address
    col.Add r3, r3.Address

    Debug.Print ExistsIn(r1, col)
    Debug.Print ExistsIn(r2, col)
    Debug.Print ExistsIn(r3, col)

    Dim r4 As Range
    Set r4 = Range("d1")
    r4 = "A1 Value"

    Debug.Print ExistsIn(r4, col)
End Sub

Вывод: 

True
True
True
True
0 голосов
/ 18 апреля 2018

Можно определить элемент коллекции с помощью варианта. В следующем примере я определяю, существует ли объект с определенным индексом в коллекции FXItems или нет. Если он не существует, система создаст его в противном случае, выполните другое действие 

            On Error Resume Next
            Dim myFXItem as FXItem
            Set myFXItem = FXItems.item("USDEUR")
            On Error GoTo 0

            If myFXItem Is Nothing Then
                Set myFXItem = New FXItem
                myFXItem.sCurr = "USDEUR"
                FXItems.Add item:=myFXItem, Key:="USDEUR"
            Else
                myFXItem.dRate = 0.834
                myFXItem.dtValueDate = #12-03-2018#
            End If
            Set myFXItem = Nothing
...