excel数据怎么实时自动刷新寻找数据并刷新原有数据_excel

经验直达：

寻找数据并刷新原有数据
excel数据怎么实时自动刷新
怎样让excel表格自动更新数据

一、寻找数据并刷新原有数据

代码如下，详见附件！

Sub test()
Dim wb As Workbook, mPath As String, i, mRow, Ary1, ary2
Dim rg As Range, d1 As Object, d2 As Object, mFile As String
Set d1 = CreateObject("scripting.dictionary")'创建字典对象
Set d2 = CreateObject("scripting.dictionary") '同上
mPath = ThisWorkbook.Path '获取路径
Application.ScreenUpdating = False'禁止闪屏
Application.DisplayAlerts = False'关闭对话
Application.Calculation = xlCalculationManual '关闭自动重算
fn = Dir(mPath & "*.xls*")
On Error Resume Next'错误继续
Do While fn <> ""
mFile = ""
Set wb = Workbooks(fn)
If Err.Number > 0 Then'若上一句发生错误（说明工作簿未打开）
mFile = fn'将该工作簿名存入变量mFile
Set wb = Workbooks.Open(mPath & "" & fn, , True)'直接相关工作簿
Err.Clear'清除错误
End If
With wb.Worksheets(1)
Set rg = .Range("A3").CurrentRegion '获取A3单元格所在连续的矩形数据区域
mRow = rg.Cells(rg.Count).Row'获取该区域最后一单元格行号
Ary1 = .Range("A3:F" & mRow) '将数据区域装入数组
For i = 1 To UBound(Ary1, 1) '按行遍历数组
If Ary1(i, 1) <> "" Then
d1(Ary1(i, 1)) = Ary1(i, 4)'将值装入字典
d2(Ary1(i, 1)) = Ary1(i, 6)
End If
Next i
End With
If mFile <> "" Then Workbooks(mFile).Close 0 '关闭代码打开的工作簿
fn = Dir'枚举一下
Loop
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
With ThisWorkbook.Worksheets(1)
.[a3].Resize(d1.Count, 1) = Application.Transpose(d1.keys) '将字典中的值写入单元格区域
.[d3].Resize(d1.Count, 1) = Application.Transpose(d1.items)
.[F3].Resize(d1.Count, 1) = Application.Transpose(d2.items)
End With
End Sub