跨文件自动更新查询结果

SCWYZJ

求助：在不打开文件的情况下，跨工作薄自动更新查询匹配数据（见附件），麻烦老师帮忙看看，谢谢

limonet

关键字：left join

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    StrSQL = "Select 实际时长 From [Sheet1$]a Left Join [Excel 12.0;Database=" & ThisWorkbook.Path & "\系统.xlsx].[时长$B2:F]b On a.学号=b.学号 And a.课程=b.课程"
    Range("F3").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

fanyoulin

用vba做的，实际使用的时候需要在代码中把文件 “副本系统.xlsx” 改成 “系统.xlsx”，并且这两个文件需要在同一个目录中；

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.13
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     p = ThisWorkbook.Path
   
6.     f = p & "\系统.xlsx"
   
7.     Set wb = Workbooks.Open(f, 0)
   
8.     With wb.Sheets(1)
   
9.         arr = .UsedRange
   
10.         wb.Close False
    
11.     End With
    
12.     For i = 3 To UBound(arr)
    
13.         If arr(i, 2) <> Empty Then
    
14.             s = arr(i, 2) & "|" & arr(i, 3)
    
15.             d(s) = arr(i, 4)
    
16.         End If
    
17.     Next
    
18.     With sh
    
19.         r = .Cells(Rows.Count, 2).End(3).Row
    
20.         .[b3:f1000].Interior.ColorIndex = 0
    
21.         For i = 3 To r
    
22.             s = .Cells(i, 3) & "|" & .Cells(i, 4)
    
23.             If d.exists(s) Then
    
24.                 .Cells(i, 6) = d(s)
    
25.             End If
    
26.             If .Cells(i, 5) = .Cells(i, 6) Then
    
27.                 .Cells(i, 2).Resize(, 5).Interior.ColorIndex = 6
    
28.             End If
    
29.         Next
    
30.     End With
    
31.     Set d = Nothing
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "OK！"
    
34. End Sub
    
35. 
    

复制代码

SCWYZJ

谢谢各位老师，我试了下，都可以。