从集合 VBA 返回索引号

Question

如果我创建了一个集合，我可以从集合中搜索该集合并返回索引编号吗？

由于我的新手状态，我无法发布我正在尝试做的截图，所以让我尝试解释一下我想要完成的内容：

我有一个 Excel 格式的仓库数据库的历史记录，它有几千行长——每行代表一个产品进出多达 10 个不同箱子的交易。我的目标是识别数千行中所有可能的不同 bin，将这 10 个 bin 复制/转置到列标题，然后遍历每笔交易并将交易数量（+1、-3 等）复制到正确的列，因此能够分离交易并更容易地识别和生成产品何时进出每个相应箱的会计。这有点看起来像一个数据透视表，但这并不是它真正的工作方式。

这是我目前正在使用 cmets 编写的代码。最后一条评论解释了我的问题：

Sub ForensicInventory()
Dim BINLOCAT As Collection
Dim Rng As Range
Dim Cell As Range
Dim sh As Worksheet
Dim vNum As Variant
Dim BINcol As Integer
Dim ACTcol As Integer
Dim QTYcol As Integer
Dim i As Integer
Dim lastrow As Long
Dim x As Long

'This part is used to find the relevant columns that will be used later
BINcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="BINLABEL", LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
ACTcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="ACTION", LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
QTYcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="QUANTITY", LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

i = 0
Set sh = ActiveWorkbook.ActiveSheet
Set Rng = sh.Range(sh.Cells(2, BINcol), sh.Cells(Rows.Count, BINcol).End(xlUp))
Set BINLOCAT = New Collection

'This next section searches the bin column and builds the collection of unique bins that I am interested in.
On Error Resume Next
    For Each Cell In Rng.Cells
        If Len(Cell.Value) <> 8 And Not IsEmpty(Cell) Then
            BINLOCAT.Add Cell.Value, CStr(Cell.Value)
        End If
    Next Cell
On Error GoTo 0

'Now I take those unique bin names and I put them into a column header on the same spreadsheet, starting in column 10, and spacing every 2 cells thereafter.
For Each vNum In BINLOCAT
    Cells(1, 10 + i).Value = vNum
    i = i + 2
Next vNum

    'Here is where the problem exists for me.  This code works and succeeds in copying the QTY
    'to column 10, but what I really want to do is determine the index number of the bin from BINLOCAT,
    'and use that index number to place the value under the appropriate column header.
For x = 2 To lastrow
  Select Case Cells(x, ACTcol).Value
      Case "MOVE-IN"
        Cells(x, 10).Value = Cells(x, QTYcol).Value
      Case "MOVE-OUT"
        Cells(x, 10).Value = -Cells(x, QTYcol).Value
      Case Else
  End Select
Next x

End Sub

在“For x = 2 to lastrow”循环中，我需要找到一种方法来通过在集合 BINLOCAT 中搜索 bin 来获取 INDEX 编号（1、2、3 等）。 BINLOCAT 一旦创建，就是静态的。我的设想是：

neededcolumn = BINLOCAT.item(cells(x,BINcol).value).index (pseudocode)

然后我会将 Case Stmt 中的 10 替换为“neededcolumn”，这样就可以了。

也许我采用了错误的方法，但在我看来，我需要集合才能有效地进行搜索部分。任何想法或解决方案的链接？根据我在其他地方所读到的内容，我认为我所描述的这种能力不可用，但我不确定我是否已经理解了迄今为止我所读到的关于集合的所有内容。

Answer 1

不要使用 for each 循环，而是使用 for n = 1 to BINLOCAT.Count 循环 - 然后 n 是您的索引。还是我误会了？

Answer 2

免责声明：好的，我将回答我自己的问题，但根据@Rory 在 8 月 18 日 13:07 的评论，我得到了这个答案。所以，谢谢你，罗里！罗里的正确回答并没有以我需要的方式启发我（或者我太笨了，看不到它 - 总是可能的），所以我不接受他的回答，但我想感谢他的帮助。我仍然怀疑可能有比我正在做的更好的方法，所以请随时评论/回答/纠正我。

为了简单和彻底，假设以下起始数据： 范围("A1:A16")=

• BM182B
• BM182B
• BM182B
• BM182B
• BM182B
• AS662B
• BM182B
• BM182B
• BM182B
• BM182B
• AS702B
• AS642B
• BM182B
• BM182B
• BM182B
• BM182B

根据 Rory 的评论，这是我想出的第一段代码：

    Sub TestofCollection()
    Dim BinCollection1 As Collection
    Dim n As Integer
    Dim x As Integer

    Set BinCollection1 = New Collection

    n = 1

    On Error Resume Next
        For Each Cell In Range("A1:A16")
            BinCollection1.Add n, CStr(Cell.Value)
            n = n + 1
        Next Cell
    On Error GoTo 0

    For x = 1 To BinCollection1.Count
        Range("B" & x).Value = BinCollection1.Item(x)
    Next x

    End Sub

问题在于输出或我得到的“索引”实际上是每个 bin 在列表中第一次出现时的位置。因此，输出段中的结果是“1,6,11,12”，而不是列表“BM182B，AS662B，AS702B，AS642B”所需的“1,2,3,4”。是否有更好的方法，我不知道，但我的解决方案是在接下来的代码中创建一个“集合的集合”，如下所示：

    Sub TestofCollection2()
    Dim BinCollection1 As Collection
    Dim BinCollection2 As Collection

    Set BinCollection1 = New Collection
    Set BinCollection2 = New Collection

    n = 1

    On Error Resume Next
        For Each Cell In Range("A1:A16")
            BinCollection1.Add Cell.Value, CStr(Cell.Value)
        Next Cell

        For Each x In BinCollection1
            BinCollection2.Add n, BinCollection1.Item(x)
            n = n + 1
        Next x
    On Error GoTo 0

    For x = 1 To BinCollection2.Count
        Range("C" & x).Value = BinCollection2.Item(x)
    Next x

    'Test output result should be 3 below
    MsgBox "Test Output:  " & BinCollection2.Item("as702b")

    End Sub

所以现在，基于这种双重收集工作，我可以搜索我的数千行 bin 列并确定它们的索引以创建我的偏移量。使用列表中的这些键，索引显示为“1,2,3,4”。

这是我在 Stack Overflow 上的第一个问题和第一个答案。我可能会给这个几天，看看是否有人有更好的答案，但是我会在这里“接受”我自己的答案，因为这对我有帮助（如果稍后出现更好的答案，我可以“不接受”我的答案吗？ ）。再次，cmets 或建议非常感谢和接受。感谢您的观看。