[已解决]输入结构类似的sub的时候，有没有批量的简便方法？

xiaojuzixxx

比如我现在做的这个代码，
都是从外部工作簿中提取数据，
然后把数据放在数组中。
Public Function lastunblankrow(location, sh, col)
lastunblankrow = location.Worksheets(sh).Range(col & "65536").End(xlUp).Row
End Function

Sub getdatanotified()
Set wbnotified = GetObject("C:\Users\Administrator\Desktop\new.xls")
e = lastunblankrow(wbnotified, "sheet1", "a")
namenotified = wblicensed.Worksheets("sheet1").Range("D3:D" & e)
locnotified = wblicensed.Worksheets("sheet1").Range("c3:c" & e)
ubnamenotified = UBound(namenotified, 1)
End Sub

Sub getdatalicensed()
Set wblicensed = GetObject("C:\Users\Administrator\Desktop\批准列表.xls")
e = lastunblankrow(wblicensed, "第一页", "a")
namelicensed = wblicensed.Worksheets("第一页").Range("c3:c" & e)
serial = wblicensed.Worksheets("第一页").Range("b3:b" & e)
ubnamelicensed = UBound(namelicensed, 1)
End Sub

getdatanotified()和getdatalicensed()
两个东西，结构是很相似的。
我就是想问下有没有办法，可以像函数一样，我只要把变量输入，
它就可以自动写出结构类似的sub来？

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2015-2-13 22:45

你这里既然用X传递变量，应该做为模块级变量声明。

1. Dim x
   
2. 
   
3. Sub q()
   
4. x = 1
   
5. End Sub
   
6. 
   
7. Function a(c)
   
8. Dim d$
   
9. d = c
   
10. Application.Run d
    
11. a = x
    
12. End Function
    
13. 
    
14. Sub test4()
    
15. m = a("q")
    
16. MsgBox m
    
17. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub demo2()
   
2.     Dim a$
   
3.     a = "demo3"
   
4.     Application.Run a
   
5. End Sub
   
6. 
   
7. Sub demo3()
   
8.     MsgBox "demo3"
   
9. End Sub
   

复制代码

这样子？

xiaojuzixxx

hwc2ycy 发表于 2015-2-11 21:30
这样子？

显示未找到demo 3

xiaojuzixxx

这个帮我看看，为什么也不行
Sub q()
x = 1
End Sub

Function a(c)
Dim d$
d = c
Application.Run.d
a = x
End Function

Sub test4()
m = a("q")
MsgBox m
End Sub

hwc2ycy

1. Sub q()
   
2. x = 1
   
3. End Sub
   
4. 
   
5. Function a(c)
   
6. Dim d$
   
7. d = c
   
8. Application.Run d
   
9. a = x
   
10. End Function
    
11. 
    
12. Sub test4()
    
13. m = a("q")
    
14. MsgBox m
    
15. End Sub
    

复制代码

hwc2ycy

你这里既然用X传递变量，应该做为模块级变量声明。

1. Dim x
   
2. 
   
3. Sub q()
   
4. x = 1
   
5. End Sub
   
6. 
   
7. Function a(c)
   
8. Dim d$
   
9. d = c
   
10. Application.Run d
    
11. a = x
    
12. End Function
    
13. 
    
14. Sub test4()
    
15. m = a("q")
    
16. MsgBox m
    
17. End Sub
    

复制代码

xiaojuzixxx

thx