一对多编码，引出多列对应编码数据

sulli112 · 发表于 2024-5-11 15:26

如图片所示，在测试表格-编码A列输入编码。自动从总库存带出所有对应测试表格-编码A列编码的整行数据，请问要怎么写呢，看了一下论坛，都是一对一带出，但是我这个不是一对一，用VOOLKUP函数只能带出其中一个结果，谢谢

cidanji · 发表于 2024-5-11 15:55

joy.008@163.com · 发表于 2024-5-11 15:56

如果只是这几条数据用VBA数组遍历就可以了
数量大的话可以考虑字典索引

全党 · 发表于 2024-5-11 16:03

Sub shishi()
Dim brr(1 To 1000, 1 To 6)
arr = Sheet2.UsedRange
ss = Sheet1.Range("a2")
For i = 2 To UBound(arr)
If arr(i, 1) = ss Then
n = n + 1
For j = 1 To 6
brr(n, j) = arr(i, j + 1)
Next
End If
Next
Sheet1.Range("b2:g1000").ClearContents
Sheet1.Range("b2").Resize(n, 6) = brr
End Sub

复制代码

sulli112 · 发表于 2024-5-11 16:23

joy.008@163.com 发表于 2024-5-11 15:56
如果只是这几条数据用VBA数组遍历就可以了
数量大的话可以考虑字典索引

原表数据很多，我只是拿了几条数据出来测试

lln0618 · 发表于 2024-5-11 16:26

Sub 复制()
'
' 复制宏
'

'

Set ws = ActiveSheet '设ws为当前表格
Set ws2 = Sheets("总库存") '

hs1 = ws.Range("A1048576").End(xlUp).Row '获取表格最后一行行号
hs2 = Sheets("总库存").Range("A1048576").End(xlUp).Row '获取表格最后一行行号

For i = 2 To hs1

For j = 2 To hs2
hs = ws.Range("A1048576").End(xlUp).Row '获取表格最后一行行号
If ws2.Cells(j, 1) = ws.Cells(i, 1) Then
ws2.Rows(j & ":" & j).Copy Destination:=ws.Rows(hs + 1 & ":" & hs + 1) '复制行到新的表格
End If
Next

Next
Rows(2 & ":" & hs1).Delete

End Sub

QQ截图20240511162513.png

测试.zip (18.93 KB, 下载次数: 6)

sulli112 · 发表于 2024-5-11 16:27

cidanji 发表于 2024-5-11 15:55

文件是不是内存太大了，我一打开就卡死，或者总表点击就崩溃

cidanji · 发表于 2024-5-11 16:31

sulli112 发表于 2024-5-11 16:27
文件是不是内存太大了，我一打开就卡死，或者总表点击就崩溃

20k能多大，你电脑软件卡了

sulli112 · 发表于 2024-5-11 16:44

cidanji 发表于 2024-5-11 16:31
20k能多大，你电脑软件卡了

不好意思，是我电脑问题，应该是EXCEL的安全兼容不行，鲜花送上，实在是不好意思

sulli112 · 发表于 2024-5-11 17:00

lln0618 发表于 2024-5-11 16:26
Sub 复制()
'
' 复制宏

感谢

		自动登录	找回密码
密码			免费注册

[求助] 一对多编码，引出多列对应编码数据

评分

评分