VBA 以分隔格式获取结果？

Question

我正在尝试弄清楚这是否可能以及如果可能的话该怎么做。

我正在尝试设置一个电子表格，当输入 PackNum 时，他们将提取该 Packnum 的所有报价，并将它们以分隔格式放入单元格中。

例如：

如果我在电子表格中输入包装号 600035 我希望它添加 B 列中分隔的所有优惠

来源：

我想要的结果

当前代码： 我原本以为我可以使用像 Findfirst 这样的东西，但意识到它只会给我第一个结果，而不是全部，而且不会按照我想要的格式设置。

Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim UpsellWB As Excel.Workbook
Dim Deletes As Excel.Worksheet
Dim lrow As Long
Dim db As DAO.Database
Dim UpsellData As DAO.Recordset

' The variable KeyCells contains the cells that will
    Set KeyCells = Range("A2:A500")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing And Range("A2").Value > 100 Then

'When cell changes run program
    'Recordsets
    Set db = DBEngine.OpenDatabase("<datapool path>\db.accdb")
    Set UpsellData = db.OpenRecordset("UpsellDeletePool")
    
    'Workbooks
    Set UpsellWB = Workbooks.Open("<spreadsheet path>\Upsell.xlsm")
    
    'Worksheets
    Set Deletes = UpsellWB.Worksheets("Deletes")

    'set lrow
    lrow = Cells(Rows.Count, 1).End(xlUp).Row

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'With Deletes
'For I = 2 To lrow
'UpsellData.FindFirst ("[Packnum]= '" & Deletes.Range("A" & I).Value & "'")
'        Deletes.Range("B" & I).Value = UpsellData.Fields("[Offer]").Value
'Next I
'End With


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
End If
'Closing Procedure
Set db = Nothing
Set UpsellData = Nothing
Set UpsellWB = Nothing
Set Deletes = Nothing

End Sub

这可能吗？任何帮助将不胜感激

Answer 1

用Excel公式就可以实现

单元格 H1 中的公式

=TEXTJOIN(",",TRUE,FILTER(B2:B15,(A2:A15=F1)*(C2:C15=F2)))