楼主
kevinchengcw |
同一个问题的vb与vba对比，看一下能让你明白如何用vb来引用vba操作excel不！
VBA代码：
- Sub test()
- Dim Wb As Workbook, NameTitleRng As Range, TelTitleRng As Range, Rng As Range, FN$, Dic As Object
- On Error GoTo Skip
- Application.ScreenUpdating = False
- Set Dic = CreateObject("scripting.dictionary")
- With ActiveWorkbook.Worksheets("Sheet1")
- Set NameTitleRng = Cells.Find("姓名")
- Set TelTitleRng = Cells.Find("电话号码")
- For Each Rng In .Range(NameTitleRng.Offset(1), .Cells(.Rows.Count, NameTitleRng.Column).End(3))
- If Rng <> "" Then Dic.Add Rng.Value, .Cells(Rng.Row, TelTitleRng.Column).Value
- Next Rng
- End With
- FN = Dir(ThisWorkbook.Path & "\*.xls?")
- Do While FN <> ""
- If FN <> ThisWorkbook.Name And FN <> ActiveWorkbook.Name Then
- Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & FN)
- With Wb.Worksheets("Sheet1")
- Set NameTitleRng = Cells.Find("姓名")
- Set TelTitleRng = Cells.Find("电话号码")
- For Each Rng In .Range(NameTitleRng.Offset(1), .Cells(.Rows.Count, NameTitleRng.Column).End(3))
- If Dic.exists(Rng.Value) Then .Cells(Rng.Row, TelTitleRng.Column) = Dic(Rng.Value)
- Next Rng
- End With
- Wb.Close True
- End If
- FN = Dir
- Loop
- Set Dic = Nothing
- Set Wb = Nothing
- Application.ScreenUpdating = True
- MsgBox "处理完成"
- Exit Sub
- Skip:
- Application.ScreenUpdating = True
- MsgBox "出错退出"
- End Sub
VB代码：
- Private Sub Command1_Click()
- Dim xlApp As Object, Dic As Object, FN$, WB, Rng1, Rng2, R
- On Error GoTo skip
- Set Dic = CreateObject("scripting.dictionary")
- Set xlApp = GetObject(, "excel.application")
- With xlApp.activeworkbook.worksheets("sheet1")
- Set Rng1 = .cells.find("姓名")
- Set Rng2 = .cells.find("电话号码")
- For Each R In .range(Rng1.offset(1), .cells(.rows.Count, Rng1.Column).End(3))
- If R <> "" Then Dic.Add R.Value, .cells(R.row, Rng2.Column).Value
- Next R
- End With
- FN = Dir(App.Path & "\*.xls?")
- xlApp.displayalerts = False
- Do While FN <> ""
- Debug.Print FN
- If FN <> xlApp.activeworkbook.Name Then
- Set WB = xlApp.workbooks.open(App.Path & "\" & FN)
- With WB.worksheets("sheet1")
- Set Rng1 = .cells.find("姓名")
- Set Rng2 = .cells.find("电话号码")
- For Each R In .range(Rng1.offset(1), .cells(.rows.Count, Rng1.Column).End(3))
- If Dic.Exists(R.Value) Then .cells(R.row, Rng2.Column) = Dic(R.Value)
- Next R
- End With
- WB.Close True
- End If
- FN = Dir
- Loop
- Set Dic = Nothing
- Set xlApp = Nothing
- MsgBox "更新完成", vbOKOnly, "提示"
- Exit Sub
- skip:
- MsgBox "出错退出", vbOKOnly, "提示"
- End Sub
- Private Sub Command2_Click()
- Unload Me
- End Sub
本是同源，用法何其相似。相关程序可于下列源帖中下载：
http://www.exceltip.net/thread-17002-1-1.html
|