如何不打开工作簿，提取对应日期数据

按照通知

如何选取今日日期和去年同期的日期，在不打开其他数据表的情况下，提取对应日期的数据

飞天篮球猪

插件解法...仅供参考

z865593849

获取数据

按照通知

z865593849 发表于 2024-12-17 14:20
获取数据

老师好，运行中出现这个情况，怎么解决

按照通知

飞天篮球猪 发表于 2024-12-17 12:28
插件解法...仅供参考

老师好，能不能把您做的插件发给我，谢谢

quqiyuan

wps的语句不一样，把那一句改为：
你测试一下。。。

conn open "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=yes';Data Source=" & p

飞天篮球猪

按照通知 发表于 2024-12-17 15:08
老师好，能不能把您做的插件发给我，谢谢

打扰了...插件不是我做的，搜一下 润乾集算器，免费的

z865593849

按照通知 发表于 2024-12-17 15:07
老师好，运行中出现这个情况，怎么解决

WPS要安装access数据库引擎，不然就用OFFICE

usedrange

1. Sub tt()
   
2.     Dim fso, fs, f, i%, wb, pa$, ar, a$, b$, r%
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     pa = ThisWorkbook.Path
   
5.     Set fs = fso.getfolder(pa).Files
   
6.     a = ThisWorkbook.Sheets(1).[m35]
   
7.     b = ThisWorkbook.Sheets(1).[m36]
   
8.     Set s = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
   
9.     s.Name = "结果"
   
10.     r = 1
    
11.     For Each f In fs
    
12.         If f.Name Like "*xls" Then
    
13.             Set wb = GetObject(f)
    
14.             With wb.Sheets(1).[a1].CurrentRegion
    
15.                 Sheet1.[a1].Resize(1, 9).Copy s.Cells(r, 1).Resize(1, 9)
    
16.                 r = r + 1
    
17.                 For i = 1 To .Rows.Count
    
18.                     If .Cells(i, 1).Value = b Then
    
19.                         .Cells(i, 1).Resize(1, 9).Copy s.Cells(r, 1).Resize(1, 9)
    
20.                         r = r + 1
    
21.                     End If
    
22.                 Next i
    
23.                 r = r + 1
    
24.                
    
25.                 For i = 1 To .Rows.Count
    
26.                     If .Cells(i, 1).Value = a Then
    
27.                         .Cells(i, 1).Resize(1, 9).Copy s.Cells(r, 1).Resize(1, 9)
    
28.                         r = r + 1
    
29.                     End If
    
30.                 Next i
    
31.                 r = r + 1
    
32.                 wb.Close
    
33.             End With
    
34.         End If
    
35.     Next f
    
36.     Set fso = Nothing
    
37.     Set fs = Nothing
    
38.     Set wb = Nothing
    
39. End Sub

复制代码

usedrange

。。。。。。。。。。。。。。。