[已解决]各位高手，请帮解决一个好复杂的问题！

sampsonpon · 发表于 2015-5-21 22:38

本帖最后由 sampsonpon 于 2015-5-21 22:39 编辑

公司局域网上，其中放有三张EXCEL表，这3张表都放在局域网上同一地方，也就是同一路径下3张不同名EXCEL表格。

如：
\\warehouse95下有表1、表2、表3
这3张表里都带有一些公式和函数，甚至还有VBA代码
表1和表2其实都是为了表3服务的，
也就是说，表1和表2一直要添加数据，而表3是事先写了一些函数要抓取表1和表2里面我想要的内容

现在假如表3在公司的生产线工作台上，早上第一次打开后就一直显示在那里不要再动了，只供大家看数据

表1被1个人在打开编辑添加新数据进去，添加完后立马保存；
表2也被另一个人在另外一个地方打开编辑添加新数据进去，添加完后也立马保存；
问表3不需要任何人手动，如何能在只要表1、表2更新了内容保存后就可以同步更新数据呢（刚刚说了，表3是抓取表1、表2的内容的）。有办法实现吗？

最佳答案

月排行榜 / 总排行榜

白开水的微笑

2015-5-22 09:38

我来替师父回答，其实就是个定时器
模块中代码

Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private mTimer As Long
'Run Every 5 Seconds
Sub StartTimer()
mTimer = SetTimer(0, 0, 5000, AddressOf ReadFile)
End Sub
'Stop Timer
Sub StopTimer()
KillTimer 0, mTimer
End Sub
Sub ReadFile()
'Read A1 In Sheet1 From Data.xlsx in the same folder
Dim Wbk As Workbook
Dim Opened As Boolean
Application.ScreenUpdating = False
On Error Resume Next
Opened = True
Set Wbk = Workbooks("Data.xlsx")
If Err.Number <> 0 Then
Opened = False
Set Wbk = Workbooks.Open(ThisWorkbook.Path & "\Data.xlsx")
End If
ThisWorkbook.Worksheets(1).Range("A1").Value = Wbk.Worksheets(1).Range("A1").Value
If Opened = False Then
Wbk.Close False
End If
Application.ScreenUpdating = True
End Sub

复制代码

ThisWorkbook中的代码

Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub
Private Sub Workbook_Open()
StartTimer
End Sub

复制代码

AutoRead.zip (20.9 KB, 下载次数: 13)

amulee · 发表于 2015-5-21 22:55

可以，做个RTD或者用API定时读取一次即可。
最简单的就是用公式直接连。

sampsonpon · 发表于 2015-5-21 22:58

amulee 发表于 2015-5-21 22:55
可以，做个RTD或者用API定时读取一次即可。
最简单的就是用公式直接连。

能告诉具体怎么做吗？一点都不懂啊！RTD和API都没听说过

白开水的微笑 · 发表于 2015-5-22 09:38

我来替师父回答，其实就是个定时器
模块中代码

Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private mTimer As Long
'Run Every 5 Seconds
Sub StartTimer()
mTimer = SetTimer(0, 0, 5000, AddressOf ReadFile)
End Sub
'Stop Timer
Sub StopTimer()
KillTimer 0, mTimer
End Sub
Sub ReadFile()
'Read A1 In Sheet1 From Data.xlsx in the same folder
Dim Wbk As Workbook
Dim Opened As Boolean
Application.ScreenUpdating = False
On Error Resume Next
Opened = True
Set Wbk = Workbooks("Data.xlsx")
If Err.Number <> 0 Then
Opened = False
Set Wbk = Workbooks.Open(ThisWorkbook.Path & "\Data.xlsx")
End If
ThisWorkbook.Worksheets(1).Range("A1").Value = Wbk.Worksheets(1).Range("A1").Value
If Opened = False Then
Wbk.Close False
End If
Application.ScreenUpdating = True
End Sub

复制代码

ThisWorkbook中的代码

Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub
Private Sub Workbook_Open()
StartTimer
End Sub

复制代码

AutoRead.zip (20.9 KB, 下载次数: 13)

白开水的微笑 · 发表于 2015-5-22 09:46

补充一下，如果你用公式直接连接，那么只要在ReadFile里面执行Calculate就行了

sampsonpon · 发表于 2015-5-22 14:48

白开水的微笑发表于 2015-5-22 09:46
补充一下，如果你用公式直接连接，那么只要在ReadFile里面执行Calculate就行了

对不起！您这样说我都不懂啊！我告诉您我文件具体文件名和具体位置吧，您把它放进您的代码里替换给我行吗？
有两张表：
COPY TO SHILIN.xlsm
kanban.xlsm
都在局域网共享盘“\\Cnwarehouse95\原始数据”这里

COPY TO SHILIN.xlsm是为kanban.xlsm服务的
也就是说kanban.xlsm第一次打开后就一直摆在那里显示着不管了，只需在COPY TO SHILIN.xlsm添加数据保存后kanban.xlsm也跟着同步更新了

sampsonpon · 发表于 2015-5-22 23:55

白开水的微笑发表于 2015-5-22 09:46
补充一下，如果你用公式直接连接，那么只要在ReadFile里面执行Calculate就行了

老师！朋友！请帮帮我吧！谢谢！

sampsonpon · 发表于 2015-5-23 10:27

白开水的微笑发表于 2015-5-22 09:46
补充一下，如果你用公式直接连接，那么只要在ReadFile里面执行Calculate就行了

高手老师，看不懂啊，您能再帮帮我吗？谢谢您！

sampsonpon · 发表于 2015-5-23 21:49

白开水的微笑发表于 2015-5-22 09:38
我来替师父回答，其实就是个定时器
模块中代码ThisWorkbook中的代码

按您给的代码，后来我自己摸索着，还真是搞定了，特别开心！特别感谢您！
还想补充问您一下，假如我想改为每3分钟刷新一次，是不是将5000改为180000？

白开水的微笑 · 发表于 2015-5-25 09:25

sampsonpon 发表于 2015-5-23 21:49
按您给的代码，后来我自己摸索着，还真是搞定了，特别开心！特别感谢您！
还想补充问您一下，假如我想改 ...

这个是毫秒计时的，5分钟就是3*60*1000

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