Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1755|回复: 8

[已解决]根据商品名查找匹配自动填入数据

[复制链接]
发表于 2021-11-29 14:08 | 显示全部楼层 |阅读模式
根据商品名查找匹配自动填入数据。涉及根据合并单元格中的商品名查找对应的多行内容,详情见附件
最佳答案
2021-12-9 13:43
山海风云轩 发表于 2021-12-9 13:07
可以看看文档吗?只看图片有点懵
我是VBA小白

請測試看看,謝謝

数据库

数据库

配方表

配方表

效果图

效果图

1127原料商品名的自动匹配-VBA研究.zip

19.65 KB, 下载次数: 27

查找匹配

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2021-11-30 13:29 | 显示全部楼层
回复

使用道具 举报

发表于 2021-12-2 16:06 | 显示全部楼层
Sub test()
Dim Arr, Brr(1 To 30000, 1 To 8), xD, xD1, T$, T1$, n%, m%, i&, j, C
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
With Sheet1
    Arr = .[a1].CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 2)
        If T <> "" Then
            xD(T & "|1") = Array(Arr(i, 4), Arr(i, 5), Arr(i, 6))
            xD1(T) = 1: n = 1: T1 = T
        Else
            n = n + 1: xD1(T1) = n
            xD(T1 & "|" & n) = Array(Arr(i, 4), Arr(i, 5), Arr(i, 6))
        End If
    Next
End With
With Sheet2
    Arr = .[a1].CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 2): R = xD1(T)
        For i2 = 1 To R
            m = m + 1: Brr(m, 1) = Arr(i, 1)
            Brr(m, 2) = Arr(i, 2)
            Brr(m, 3) = xD(T & "|" & i2)(0)
            Brr(m, 4) = xD(T & "|" & i2)(1)
            Brr(m, 5) = Arr(i, 3)
            Brr(m, 6) = xD(T & "|" & i2)(2)
        Next
    Next
End With
xD.RemoveAll: C = Array(1, 2, 5)
With Sheet3
    .[a1].CurrentRegion.Offset(1, 0).EntireRow.Delete
    With .[a2].Resize(m, 8)
        .Value = Brr
        .Borders.LineStyle = xlContinuous
    End With
    For Each j In C
        For i = 1 To m
            T = Brr(i, j)
            If xD.Exists(T) Then
                Set xD(T) = Union(xD(T), .Cells(i + 1, j))
            Else
                Set xD(T) = .Cells(i + 1, j)
            End If
        Next
        For Each ky In xD.keys: xD(ky).Merge: Next
        xD.RemoveAll
    Next
End With
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub

1.JPG
回复

使用道具 举报

 楼主| 发表于 2021-12-9 13:07 | 显示全部楼层
sam-wang 发表于 2021-12-2 16:06
Sub test()
Dim Arr, Brr(1 To 30000, 1 To 8), xD, xD1, T$, T1$, n%, m%, i&, j, C
Application.Screen ...

可以看看文档吗?只看图片有点懵
我是VBA小白
回复

使用道具 举报

发表于 2021-12-9 13:43 | 显示全部楼层    本楼为最佳答案   
山海风云轩 发表于 2021-12-9 13:07
可以看看文档吗?只看图片有点懵
我是VBA小白

請測試看看,謝謝

根据商品名查找匹配自动填入数据_1209.zip

106.37 KB, 下载次数: 24

回复

使用道具 举报

 楼主| 发表于 2021-12-9 15:32 | 显示全部楼层
可以加V请教吗?大佬,我的是feng163183
回复

使用道具 举报

发表于 2021-12-11 13:57 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2021-12-14 16:05 | 显示全部楼层
sam-wang 发表于 2021-12-2 16:06
Sub test()
Dim Arr, Brr(1 To 30000, 1 To 8), xD, xD1, T$, T1$, n%, m%, i&, j, C
Application.Screen ...

可以附上代码解析吗?
回复

使用道具 举报

发表于 2021-12-14 18:32 | 显示全部楼层
山海风云轩 发表于 2021-12-14 16:05
可以附上代码解析吗?

可以附上代码解析吗?
>> 如附件,寫得不好,請見諒,謝謝

根据商品名查找匹配自动填入数据_1214.zip

103.97 KB, 下载次数: 21

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 04:56 , Processed in 0.757751 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表