|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 fzxba 于 2023-1-18 12:38 编辑
- Sub test1() '改一下
- Dim Conn As Object, SQL As String, strConn As String
- Dim ar, i As Integer, sFields As String
- Application.ScreenUpdating = False
- Set Conn = CreateObject("ADODB.Connection")
- If Application.Version < 12 Then
- strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="
- Else
- strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source="
- End If
- Conn.Open strConn & ThisWorkbook.FullName
- With Worksheets("Sheet1")
- ar = .Range("B1", .Range("B1").End(xlToRight))
- sFields = "HOUR(DATEADD('n',30," & ar(1, 1) & ")) AS 时间段"
- For i = 2 To UBound(ar, 2)
- sFields = sFields & ",AVG([" & ar(1, i) & "]) AS " & ar(1, i) & "均值"
- Next
- SQL = "SELECT " & sFields & " FROM [" & .Name & "$] WHERE LEN( " & ar(1, 1) & ") GROUP BY HOUR(DATEADD('n',30," & ar(1, 1) & "))"
- End With
- With Worksheets("Sheet2").Range("B1")
- .CurrentRegion.ClearContents
- .Resize(, UBound(ar, 2)) = ar
- .Offset(1).CopyFromRecordset Conn.Execute(SQL)
- ar = .CurrentRegion
- For i = 2 To UBound(ar)
- ar(i, 1) = "[ " & Format(ar(i, 1) - 1, "00") & ":30 - " & Format(ar(i, 1), "00") & ":30 )"
- Next
- .CurrentRegion = ar
- End With
- Conn.Close
- Set Conn = Nothing
- Application.ScreenUpdating = True
- Beep
- End Sub
复制代码
|
|