数据查找和输出

nemoium

商品目录

如图， 就是根据工作簿1中的商品名称和规格，在商品目录工作簿中，查找，结果输出到一个新的sheet或文件中都可以。 工作簿1和商品目录excel文件.zip (17.98 KB, 下载次数: 9)

2023-3-9 20:36 上传

点击文件名下载附件

joy.008@163.com

joy.008@163.com

Sub PPP()

Dim arr, brr, d As Object, i%, k%, y, p

Set d = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range("A1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 3)
For i = 2 To UBound(arr)
    If d.exists(arr(i, 2) & "|" & arr(i, 3)) Then
        d(arr(i, 2) & "|" & arr(i, 3)) = d(arr(i, 2) & "|" & arr(i, 3)) & "," & arr(i, 1)
        Else
        d(arr(i, 2) & "|" & arr(i, 3)) = arr(i, 1)
    End If
Next
        
arr = Sheet1.Range("H1").CurrentRegion
k = 1: brr(1, 1) = "编号": brr(1, 2) = "名称": brr(1, 3) = "规格"
For i = 2 To UBound(arr)
    p = arr(i, 1) & "|" & arr(i, 2)
    If d.exists(p) Then
          For Each y In Split(d(p), ",")
            If y <> "" Then
                k = k + 1
                brr(k, 1) = y
                brr(k, 2) = arr(i, 1)
                brr(k, 3) = arr(i, 2)
            End If
         Next
    End If
Next

[K1].Resize(k, 3) = brr

End Sub

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, i&, j&, r&, dic As Object, strKey$, strFileName$, strPath$
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "商品目录.xlsx"
    If Dir(strFileName) = "" Then MsgBox "指定的文件不存在，请检查！", vbExclamation: Exit Sub
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    ar = [A1].CurrentRegion
    For i = 2 To UBound(ar)
        strKey = ar(i, 1) & "|" & ar(i, 2)
        dic(strKey) = ""
    Next
   
    With GetObject(strFileName)
        With .Sheets(1)
            ar = .[A1].CurrentRegion
            r = 1
            For i = 2 To UBound(ar)
                strKey = ar(i, 2) & "|" & ar(i, 3)
                If dic.exists(strKey) Then
                    r = r + 1
                    For j = 1 To 3
                        ar(r, j) = ar(i, j)
                    Next j
                End If
            Next i
        End With
        .Close False
    End With
   
    With [A12]
        .CurrentRegion.Clear
        .Resize(r, 3) = ar
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

nemoium

joy.008@163.com 发表于 2023-3-9 21:11

对，就这样。怎么弄？

nemoium

joy.008@163.com 发表于 2023-3-9 21:11

最好是商品目录一个文件，待查询内容一个文件，结果输出到另一个文件。

gwjkkkkk

请参考。。。

nemoium

gwjkkkkk 发表于 2023-3-9 21:27
请参考。。。

对，是这样。商品目录一个文件，待查询内容一个文件，然后，结果输出到另一个文件

nemoium

gwjkkkkk 发表于 2023-3-9 21:27
请参考。。。

商品目录一个文件，待查询内容一个文件，然后，把结果输出到另一个文件。有这样的程序吗？

joy.008@163.com

nemoium 发表于 2023-3-9 21:24
对，就这样。怎么弄？

程序已提交 审核中