[已解决]求帮助,写一个SUB宏命令.

falcon9999

过程都在附件中写了,这里也不知道怎么描述,麻烦有时间的大神,帮忙看看.成分感谢.

最佳答案

月排行榜 / 总排行榜

chart888

2017-7-10 09:32

1. Private Sub CommandButton1_Click()
   
2. Dim r, Arr, i, j
   
3. Application.ScreenUpdating = False
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. With Worksheets("Sheet3")
   
6.     Arr = Worksheets("表格1").[A1].CurrentRegion
   
7.     For j = 2 To UBound(Arr)
   
8.         d(Arr(j, 4)) = j
   
9.     Next
   
10.     r = .Range("A65536").End(xlUp).Row
    
11.     For i = 2 To r
    
12.         .Cells(i, 8) = .Cells(i, 1) & "-" & .Cells(i, 3)
    
13.         If d.exists(.Cells(i, 8).Value) Then
    
14.             j = d(.Cells(i, 8).Value)
    
15.             .Cells(i, 10) = Arr(j, 6)
    
16.             .Cells(i, 11) = Arr(j, 9)
    
17.         End If
    
18.         .Cells(i, 9) = .Cells(i, 10) & "," & .Cells(i, 2)
    
19.     Next
    
20. End With
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

跳转到最佳答案楼层

chart888

1. Private Sub CommandButton1_Click()
   
2. Dim r, Arr, i, j
   
3. Application.ScreenUpdating = False
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. With Worksheets("Sheet3")
   
6.     Arr = Worksheets("表格1").[A1].CurrentRegion
   
7.     For j = 2 To UBound(Arr)
   
8.         d(Arr(j, 4)) = j
   
9.     Next
   
10.     r = .Range("A65536").End(xlUp).Row
    
11.     For i = 2 To r
    
12.         .Cells(i, 8) = .Cells(i, 1) & "-" & .Cells(i, 3)
    
13.         If d.exists(.Cells(i, 8).Value) Then
    
14.             j = d(.Cells(i, 8).Value)
    
15.             .Cells(i, 10) = Arr(j, 6)
    
16.             .Cells(i, 11) = Arr(j, 9)
    
17.         End If
    
18.         .Cells(i, 9) = .Cells(i, 10) & "," & .Cells(i, 2)
    
19.     Next
    
20. End With
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

grf1973

第一步：把表格1的F列表头" Nbr."， 去掉空格和点号，改为Nbr (附件里已改好）
第二步：点击即可。

grf1973

主要是因为列字段" Nbr."含空格和点号后，无法作为列字段提取，哪怕是用[]也不行。。。。。。

falcon9999

chart888 发表于 2017-7-10 09:32

非常感谢您的帮助,又跟您学习了.另外请教一下,With Worksheets("sheet3"),这句可以改为当前表格,或任意表格吗?

falcon9999

grf1973 发表于 2017-7-10 11:19
第一步：把表格1的F列表头" Nbr."， 去掉空格和点号，改为Nbr (附件里已改好）
第二步：点击即可。

感谢您在百忙中的帮助,生命中愿意帮助我的人,都 是我的贵人.再次表示感谢.

chart888

falcon9999 发表于 2017-7-10 12:28
非常感谢您的帮助,又跟您学习了.另外请教一下,With Worksheets("sheet3"),这句可以改为当前表格,或任意表 ...

With Worksheets("sheet3")
改成当前工作表
With Activesheet
改成别的工作
With Worksheets("sheet3")  红色的修改为工作表名称

falcon9999

老师您好.今天再使用您帮我做的这个命令时,发现一个问题,就是当B列的数字为三位数时,组合到K列,就显示不对了.

chart888

falcon9999 发表于 2017-7-12 20:26
老师您好.今天再使用您帮我做的这个命令时,发现一个问题,就是当B列的数字为三位数时,组合到K列,就显示不对 ...

我晚点上来给你看看

chart888

falcon9999 发表于 2017-7-12 20:26
老师您好.今天再使用您帮我做的这个命令时,发现一个问题,就是当B列的数字为三位数时,组合到K列,就显示不对 ...

你把I列的单元格格式改为文本格式就OK了