Question

我是exal macros / vba的新手，我遇到了一个我不知道该如何处理的问题。

我有一本包含几张纸的工作簿。有1个文件或多或少是主列表，而3个文件则是装箱单。

我在3个装箱单中分别放置了一个带有宏的命令按钮，它告诉我装箱单中是否存在某个项目，并且告诉我它出现在哪一行。工作正常，但是我的问题是，如果特定项目在主列表中多次出现（由于购买日期不同），则该宏只会给出第一个结果。

我想知道是否有任何方法可以显示所有可能的结果，而不仅仅是第一个。

下面是我使用的代码示例

Private Sub CommandButton1_Click()

Dim k As Integer

For k = 3 To 1000

Cells(k, 24).Value = Application.Match(Cells(k, 2), Sheets("master").Range("B2:B1000"), 0)

Next k

End Sub

Answer 1

我将使用dictionary将每个项目存储在主表中，并且每次发现重复项时，都在其行中添加另一个数字，如下所示：

Option Explicit
Private Sub CommandButton1_Click()

    Dim MasterKeys As Object

    MasterKeys = FillDictionary(MasterKeys)

    With ThisWorkbook.Sheets("MySheet") 'change MySheet for your actual sheet name

        Dim arr As Variant
        arr = .UsedRange.Value 'drop your data inside an array

        Dim i As Long

        For i = 3 To UBound(arr) 'loop through all the rows in your data
            If MasterKeys.Exists(arr(i, 2)) Then arr(i, 24) = MasterKeys(arr(i, 2))
        Next i

        .UsedRange.Value = arr 'drop back your data

    End With

End Sub
Function FillDictionary(MasterKeys As Object) As Object

    Set MasterKeys = CreateObject("Scripting.Dictionary")

    With Workbooks("MasterWorkbook.xlsx").Sheets("master") 'change MasterWorkbook for the actual filename of your master workbook

        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row 'find the last row on column B

        Dim C As Range
        For Each C In .Range("B2:B" & LastRow) 'loop through the range
            If Not MasterKeys.Exists(C.Value) Then
                MasterKeys.Add C.Value, C.Row
            Else
                MasterKeys(C.Value) = MasterKeys(C.Value) & "," & C.Row
            End If
        Next C

    End With

End Function

Answer 2

如果您的“主”工作表数据是从B2到最后一个不为空的连续不为空单元格的列表，那么这是另一种方法

Option Explicit

Private Sub CommandButton1_Click()
    Dim cell As Range

    With Worksheets("master") ' reference your "master" sheet
        With .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)) ' reference referenced sheet column B range from row 2 down to last not empty one
            For Each cell In Range("B3", Cells(Rows.Count, "B").End(xlUp)) ' loop through packinglist sheet (i.e. where button resides) column B cells from row 3 down to last not empty one
                If Not .Find(what:=cell.Value2, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then ' if current packinglist item is in "master"
                    .Replace what:=cell.Value2, replacement:=vbNullString, lookat:=xlWhole ' temporarily replace master item with a blank
                    cell.Offset(, 22).Value2 = Replace(.SpecialCells(xlCellTypeBlanks).Address(False, False), "B", "") ' write master list blanks rows in packinglist sheet current item row and column "X"
                    .SpecialCells(xlCellTypeBlanks).Value = cell.Value2 ' restore master list current packinglist item value
                End If
            Next
        End With
    End With
End Sub

Excel宏中的匹配函数仅给出第一个结果

2 个答案: