smt bom+vba

civar · 发表于 2010-12-19 21:33

小第想请各位大哥帮忙....想将用vba 将sheet1 的bom合并...结果显示在 sheet2......谢谢

sheet1                                                                                  sheet2
pn          id                                                    pn                   id                         qty
A          R1                                                    A             R1,R3,R4,R13             4
A          R3                                                    B             C1,C2                         2
A          R13                                                 C             R5                               1
B          C1
B          C2
C          R5
A          R4

zm0115 · 发表于 2010-12-19 22:03

test.rar (10.71 KB, 下载次数: 383)

civar · 发表于 2010-12-20 00:15

真的很感谢楼上的仁兄.......谢谢.....

duwei9981 · 发表于 2010-12-29 09:06

收藏备用！谢谢！

civar · 发表于 2011-1-2 10:04

请问为什么有时会出现error 13.....

shinying · 发表于 2011-1-12 15:10

怎么解决这个问题：

相同的PN的 ID太多，超过了256个字符，VBA会报错，怎么解决！

zm0115 · 发表于 2011-1-13 11:42

原帖由 shinying 于 2011-1-12 15:10 发表
怎么解决这个问题：

相同的PN的 ID太多，超过了256个字符，VBA会报错，怎么解决！

代码变成：

Sub 按钮1_Click()
Dim arr
Dim rng1 As Range, rng2 As Range
Dim dic As Object, dic1 As Object
arr = Array("Pn", "id", "qty")
Sheet2.Cells.ClearContents
Sheet2.Range("a1:c1") = arr
Set rng1 = Sheet1.Range(Cells(2, 1), Cells(Rows.Count, 1).End(3))
Set dic = CreateObject("Scripting.Dictionary")
Set dic1 = CreateObject("Scripting.Dictionary")
For Each rng2 In rng1
If dic.exists(rng2.Value) Then
dic(rng2.Value) = dic(rng2.Value) & "," & rng2.Offset(, 1).Value
dic1(rng2.Value) = dic1(rng2.Value) + 1
Else
dic(rng2.Value) = rng2.Offset(, 1).Value
dic1(rng2.Value) = 1
End If
Next
arr = dic.keys
For x = 1 To dic.Count
Sheet2.Range("a" & x + 1) = arr(x - 1)
Sheet2.Range("b" & x + 1) = dic.Item(arr(x - 1))
Sheet2.Range("c" & x + 1) = dic1.Item(arr(x - 1))
Next
Set dic = Nothing
Set dic1 = Nothing
End Sub

复制代码

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

[求助] smt bom+vba

谢谢

error 13