年月日时按月分表

xing_chen

LIUZHU 发表于 2023-1-9 16:30
JS宏方案

老师我已下载图片，备用。谢谢

xing_chen

supermouse24 发表于 2023-1-9 16:29
Sub 按月提取数据()
    arr = [a1].CurrentRegion.Value
   

谢谢老师！运行如愿！

mmwwdd

Sub test()
Dim cnn As Object
Dim rs As Object
Dim MySQL As String
Dim sht As Worksheet
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set d = CreateObject("scripting.dictionary")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
With Sheets("原表")
  r = .Cells(.Rows.Count, 1).End(3).Row
    For i = 2 To r
    yf = Month(.Cells(i, 9))
    If Not d.exists(yf) Then
     MySQL = "select * from [原表$] where month(列9)='" & yf & "'"
     rs.Open MySQL, cnn, 1, 3
     Sheets.Add
     ActiveSheet.Name = yf & "月"
     For j = 0 To rs.Fields.Count - 1
         Cells(1, j + 1) = rs.Fields(j).Name
     Next
     ActiveSheet.Range("A2").CopyFromRecordset rs
     MySQL = ""
     d(yf) = ""
     rs.Close
    End If
Next
End With
End Sub

mmwwdd

用SQL给你做一个,SQL速度快

ykcbf1100

xing_chen 发表于 2023-1-9 16:11
谢谢老师！运行如愿！
老师！疫情期间身体保重
另，花在旅途，到时献上

谢谢。疫情期间你也保重身体。
更新一下，月份表名从左到右按从小到大排序。

mmwwdd

有些时候用字典字段太多,这时候SQL就显示出简洁了

xing_chen

mmwwdd 发表于 2023-1-10 08:19
用SQL给你做一个,SQL速度快

谢谢老师！运行如愿

xing_chen

ykcbf1100 发表于 2023-1-10 09:24
谢谢。疫情期间你也保重身体。
更新一下，月份表名从左到右按从小到大排序。

谢谢老师！运行如愿！再谢谢你的精益求精