求助设置表格

小星光

小星光 发表于 2024-4-5 09:02
yynrzwh老师：谢谢！

老师你好∶其他年度不能查到。

baofa2

1. Sub test0()
   
2.   Dim Conn As Object, SQL As String, strConn As String
   
3.   Dim Y As Long, Q As Long, M As Long
   
4.   Set Conn = CreateObject("ADODB.Connection")
   
5.   If Application.Version < 12 Then
   
6.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="
   
7.   Else
   
8.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source="
   
9.   End If
   
10.   Conn.Open strConn & ThisWorkbook.FullName
    
11.   Worksheets(2).Activate
    
12.   ActiveSheet.UsedRange.Offset(2).Clear 'Contents
    
13.   Y = Range("J1").Value
    
14.   Q = DatePart("Q", DateSerial(Y, Range("J2").Value, 1))
    
15.   M = 1 + (Q - 1) * 3
    
16.   With Worksheets(1)
    
17.     .Range("A1").CurrentRegion.Columns(1).NumberFormatLocal = "@"   '2023是数值 2024却是文本 这里统一为文本
    
18.     SQL = "SELECT * FROM [" & .Name & "$A2:H] WHERE 年+0=" & Y & " AND 月+0 BETWEEN " & M & " AND " & M + 2
    
19.   End With
    
20.   Range("A3").CopyFromRecordset Conn.Execute(SQL)
    
21.   Range("H2", Cells(Rows.Count, "A").End(xlUp)).Borders.LineStyle = xlContinuous
    
22.   Conn.Close
    
23.   Set Conn = Nothing
    
24. End Sub

复制代码

baofa2

审核附件测试.zip (22.03 KB, 下载次数: 3)

2024-4-5 09:26 上传

点击文件名下载附件

小星光

baofa2 发表于 2024-4-5 09:26

非常感谢各位大师！谢谢您们！