[已解决]VBA

清风云子 · 发表于 2012-12-16 10:10

各位老师好：
   请问可以用一个工作簿里的代码向另一个没有打开的工作簿里写入数据，或读取数据吗？
   比如有123.xls 和 abc.xls 两个工作簿，123打开了，现在要向abc的sheet1的A1中写入 123的sheet2的B2的值，该如何写代码。谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-12-16 10:45

本帖最后由 hwc2ycy 于 2012-12-16 10:51 编辑

Sub 写入数据()
Dim wbabc$
Dim b2
wbabc = "abc.xls"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
b2 = Worksheets("sheet1").Range("b2")
If Workbooks(wbabc) Is Nothing Then
On Error Resume Next
Workbooks.Open thidworkbook.Path & "" & wbabc
If Err.Number <> 0 Then
MsgBox wbabc & " error"
Err.Clear
Exit Sub
End If
Else
Workbook(wbacb).Activate
End If
Worksheets("sheet2").Range("a1") = b2
ActiveWorkbook.Close True
Application.ScreenUpdating = ture
Application.DisplayAlerts = True
End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy · 发表于 2012-12-16 10:36

没打开，你可以用代码打开嘛，写完再关闭。

hwc2ycy · 发表于 2012-12-16 10:45

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

本帖最后由 hwc2ycy 于 2012-12-16 10:51 编辑

Sub 写入数据()
Dim wbabc$
Dim b2
wbabc = "abc.xls"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
b2 = Worksheets("sheet1").Range("b2")
If Workbooks(wbabc) Is Nothing Then
On Error Resume Next
Workbooks.Open thidworkbook.Path & "" & wbabc
If Err.Number <> 0 Then
MsgBox wbabc & " error"
Err.Clear
Exit Sub
End If
Else
Workbook(wbacb).Activate
End If
Worksheets("sheet2").Range("a1") = b2
ActiveWorkbook.Close True
Application.ScreenUpdating = ture
Application.DisplayAlerts = True
End Sub

复制代码

hwc2ycy · 发表于 2012-12-16 10:45

其实你直接跨工作簿引用也可以的。

清风云子 · 发表于 2012-12-16 10:47

hwc2ycy 发表于 2012-12-16 10:36
没打开，你可以用代码打开嘛，写完再关闭。

呵呵，谢谢您的回答，其实我可以把这两个工作簿放在一起，问题是如果将来数据越来越多的时候，影响速度，所以我想把保存的记录（不经常用到的）放到另一个工作簿中去，如果每次都要用代码打开，再写入数据，是不是也影响速度了呢，我这种要求最好用数据库的，可惜我不会操纵数据库……

hwc2ycy · 发表于 2012-12-16 10:48

在abc的sheet1的A1中引用123的sheet2的B2就行了。

hwc2ycy · 发表于 2012-12-16 10:50

这有什么影响速度的，没有绝对意义的不打开。只是你看不看到而已。
你用SQL，只是换了一种打开方式而已。

zjdh · 发表于 2012-12-16 10:52

Sub test()
  Application.ScreenUpdating = False
  Set wk = Workbooks.Open(ThisWorkbook.Path & "\abc.xls")
  ThisWorkbook.Sheets("SHEET2").Range("B2").Copy wk.Sheets("sheet1").Range("A1")
  wk.Close True
  Application.ScreenUpdating = True
  MsgBox "复制完成！"
End Sub

新建文件夹.rar (13.04 KB, 下载次数: 3)

清风云子 · 发表于 2012-12-16 10:57

zjdh 发表于 2012-12-16 10:52
Sub test()
Application.ScreenUpdating = False
Set wk = Workbooks.Open(ThisWorkbook.Path & "\ab ...

感谢帮助，谢谢您！

乐山123 · 发表于 2012-12-16 20:22

可以用ACCESS+EXCEL比较方便

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