[已解决]本人想用字典法替换原录制模块，谢谢了，各位老师

icenotcool

各位老师：麻烦帮我用字典法或者find重新写一个模块代替现有录制模块，谢谢！ 例子.rar (57.32 KB, 下载次数: 5)

2015-11-20 15:14 上传

点击文件名下载附件
阅读权限: 10

最佳答案

月排行榜 / 总排行榜

grf1973

2015-11-20 10:05

1. Sub 字典法()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheets("工资表").[a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 2)) = arr(i, 1)
   
6.     Next
   
7.    
   
8.     arr = [a1].CurrentRegion
   
9.     For i = 2 To UBound(arr)
   
10.          arr(i, 1) = d(arr(i, 2))
    
11.     Next
    
12.     [a1].Resize(UBound(arr), 1) = Application.Index(arr, , 1)
    
13. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 字典法()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheets("工资表").[a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 2)) = arr(i, 1)
   
6.     Next
   
7.    
   
8.     arr = [a1].CurrentRegion
   
9.     For i = 2 To UBound(arr)
   
10.          arr(i, 1) = d(arr(i, 2))
    
11.     Next
    
12.     [a1].Resize(UBound(arr), 1) = Application.Index(arr, , 1)
    
13. End Sub
    

复制代码

icenotcool

grf1973 发表于 2015-11-20 10:05

谢谢老师了，就是我想要的

grf1973

公式法也不错的，至少代码简洁。

1. Sub 提取()
   
2.     r = [a65536].End(3).Row
   
3.     Range("a2").Formula = "=VLOOKUP(B2,if({1,0},工资表!B:B,工资表!A:A),2,)"
   
4.     Range("a2").AutoFill Destination:=Range("A2:A" & r)
   
5.     Range("A2:A" & r).Value = Range("A2:A" & r).Value
   
6. End Sub

复制代码

grf1973

再简单一点

1. Sub 提取二错误()
   
2.     r = [a65536].End(3).Row
   
3.     Range("a2:a" & r).Formula = "=VLOOKUP(RC[1],if({1,0},工资表!c2:c2,工资表!c1:c1),2,)"
   
4.     Range("A2:A" & r).Value = Range("A2:A" & r).Value
   
5. End Sub

复制代码

icenotcool

grf1973 发表于 2015-11-20 10:24
公式法也不错的，至少代码简洁。

但是速度有点卡，老师

icenotcool

grf1973 发表于 2015-11-20 10:27
再简单一点

老师，可以把我的按钮改成浮动按钮吗？谢谢

grf1973

冻结窗格不就可以了？

icenotcool

grf1973 发表于 2015-11-20 10:34
冻结窗格不就可以了？

这个是给别人用的，怕她不小心指定宏点错更换宏了，

icenotcool

grf1973 发表于 2015-11-20 10:27
再简单一点

老师，浮动按钮已经弄好了，但是要把按钮文字把“隐藏”改为“操作”,谢谢 举例.rar (56.06 KB, 下载次数: 4)

2015-11-20 14:54 上传

点击文件名下载附件
阅读权限: 10