麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
'目的：每間隔 10 分鐘、每一個 CTcode 做欄位 Volts,Hz 的平均值，
' 並依已間隔之時間序及CTcode 序呈現結果
Sub ExcelSQL()
Dim SQL As String, TimeIntervalStr$
Dim j%, r%
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim ws As Worksheet
Dim StartTime#
Set ws = Sheets("Temp")
StartTime = Timer
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Extended Properties= Excel 12.0;" _
& "Data Source=" & ThisWorkbook.FullName
.Open
End With
Set rs = New ADODB.Recordset
'' SQL = " select * from [CT$] where [日期時間] between #2015/6/1# and #2015/6/2#"
TimeIntervalStr = " DateAdd(" + """n""" + ",10,[日期時間] )" '每間隔10分鐘
SQL = "SELECT" + TimeIntervalStr + " as [DateTime],avg(Volts) as avgVolt,AVg(Hz) as avgHz " & _
"from [CT$] " & _
"where [日期時間] between #2015/06/01# and #2015/06/02# " & _
"Group by [DateTime],CTcode " & _
"Order by [DateTime]"
Debug.Print SQL
rs.Open SQL, cnn
With ws
.Cells.Clear
For j = 0 To rs.Fields.Count - 1
.Cells(1, j + 1) = rs.Fields(j).Name
Next
r = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A" & r + 1).CopyFromRecordset rs
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Debug.Print Timer - StartTime
End Sub

複製代碼

'目的：每間隔 10 分鐘、每一個 CTcode 做欄位 Volts,Hz 的平均值，
' 並依已間隔之時間序及CTcode 序呈現結果
Option Explicit
Option Base 1
Option Private Module
'Definitions for ADODB SQL
Public cnn As ADODB.Connection
Public rs As ADODB.Recordset
Public SQL As String, FileName$
Public ws1 As Worksheet
Public ws2 As Worksheet
Public TimeInterval#
Public Time0#
Public StartTime$, EndTime$, TimeStr$
Sub ExcelSQL()
Dim i&, j%
Set ws1 = Sheets("CT")
Set ws2 = Sheets("Temp")
ws2.Cells.Clear
FileName = ThisWorkbook.FullName
ws1.Select
StartTime = Format(Cells(2, 1), "yyyy/mm/dd hh:mm")
EndTime = Format(Cells([A1].CurrentRegion.Rows.Count, 1), "yyyy/mm/dd hh:mm")
TimeInterval = 10 '間隔 10 分鐘
Time0 = Timer
'=== 賦予時間間格的新欄位 =============
Set cnn = New ADODB.Connection
cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
cnn.ConnectionString = "Data Source=" & FileName & ";Extended Properties=""Excel 12.0 xml;HDR=Yes;"""
cnn.Open
SQL = "Select format( iif(minute([日期時間]) mod " & TimeInterval & " = 0,[日期時間], " & _
"DateAdd(""n"", " & TimeInterval & "-minute([日期時間]) mod " & TimeInterval & _
" ,[日期時間])),""yyyy/mm/dd HH:mm"") " & _
" From [" & ws1.Name & "$]" & _
" where [日期時間] >= #" & StartTime & "# " & _
" order by [日期時間]"
Set rs = cnn.Execute(SQL)
With ws1
j = .[A1].End(xlToRight).Column
.Cells(1, j + 1) = "DateTime1"
.Cells(2, j + 1).CopyFromRecordset rs
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
'=== 處理數值欄位的平均 ===========================
Set cnn = New ADODB.Connection
cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
cnn.ConnectionString = "Data Source=" & FileName & ";Extended Properties=""Excel 12.0 xml;HDR=Yes;"""
cnn.Open
SQL = "SELECT format([DateTime1],""yyyy/mm/dd HH:mm"") as [DateTime], CTCode, " & _
"AVG([Volts]) as [avgVolt], AVG([Hz]) as [avgHz], AVG([kW]) as [avgkW] " & _
" From [" & ws1.Name & "$] " & _
" Where [日期時間] >= #" & StartTime & "# and [DateTime1] <= #" & EndTime & "# " & _
" Group by [DateTime1],CTCode " & _
" Order by [DateTime1] ,CTCode"
Debug.Print SQL
Set rs = cnn.Execute(SQL)
With ws2
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1) = rs.Fields(i).Name
Next
.Cells(2, 1).CopyFromRecordset rs
End With
ws1.Select
Cells(1, ws1.UsedRange.Columns.Count).EntireColumn.Clear
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
' Debug.Print Timer - Time0
End Sub

複製代碼

Option Explicit
Sub ExcelSQL()
Dim SQL As String, TimeIntervalStr As Double
Dim j%, r%
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
Set cnn = New ADODB.Connection
With cnn
'.Provider = "Microsoft.ACE.OLEDB.12.0"
' .ConnectionString = "Extended Properties= Excel 12.0;" _
& "Data Source=" & ThisWorkbook.FullName
'建議不要 Source=" & ThisWorkbook.FullName 在這資料庫活頁簿中執行此巨集,很耗記憶體
'**********************************************************
'2003版引用：microsoft activex data objects 2.x library
.Provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Extended Properties= Excel 8.0;" _
& "Data Source=D:\VBA SQL.xls"
'建議不要 Source=" & ThisWorkbook.FullName 在這資料庫活頁簿中執行此巨集,很耗記憶體
.Open
End With
Set rs = New ADODB.Recordset
SQL = "select * from [ct$] "
rs.Open SQL, cnn
With ws
.[A1].CopyFromRecordset rs
TimeIntervalStr = .[A1] '取得第一個時間
.UsedRange.Clear
End With
Do
Set rs = New ADODB.Recordset
SQL = "SELECT CTcode, avg(test.Volts) as Volts平均,avg(test.Hz) as Hz平均 from [CT$] " & _
" as test where 日期時間 >=" & TimeIntervalStr & " AND 日期時間 <" & CDbl(DateAdd("n", 10, TimeIntervalStr)) & " Group by CTcode "
rs.Open SQL, cnn, adOpenStatic, adLockReadOnly
If rs.RecordCount Then '讀取紀錄
With ws
If .UsedRange.Count = 1 Then
.Cells(1) = "日期時間"
For j = 0 To rs.Fields.Count - 1
.Cells(1, j + 2) = rs.Fields(j).Name
Next
End If
r = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("B" & r + 1).CopyFromRecordset rs
r = .Cells(.Rows.Count, 2).End(xlUp).Row
With .Range("A" & Rows.Count).End(xlUp).Offset(1)
.Resize(r - .Row + 1) = DateAdd("n", 0, TimeIntervalStr) & vbLf & DateAdd("n", 10, TimeIntervalStr)
End With
End With
End If
TimeIntervalStr = CDbl(DateAdd("n", 10, TimeIntervalStr)) '下一個10分鐘
Loop Until rs.RecordCount = 0 '無紀錄
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

複製代碼

Sub ExcelAddColumn()
Dim SQL As String
Dim j%, r%
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim ws As Worksheet
Time0 = Timer
Set ws = ThisWorkbook.Sheets(1)
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Extended Properties= Excel 12.0;" _
& "Data Source=D:\VBA SQL.xlsm"
'建議不要 Source=" & ThisWorkbook.FullName 在這資料庫活頁簿中執行此巨集,很耗記憶體
'**********************************************************
' '2003版引用：microsoft activex data objects 2.x library
' .Provider = "microsoft.jet.oledb.4.0"
' .ConnectionString = "Extended Properties= Excel 8.0;" _
' & "Data Source=D:\VBA SQL.xls"
' '建議不要 Source=" & ThisWorkbook.FullName 在這資料庫活頁簿中執行此巨集,很耗記憶體
.Open
End With
SQL = "Alter Table [CT$] ADD NewColumn char(10)" '要增加一欄位名稱
'' 出現"無效的運算" 錯誤
cnn.Execute SQL
Set rs = New ADODB.Recordset
SQL = "select * from [CT$] "
rs.Open SQL, cnn
Debug.Print rs.Fields.Count
End Sub

複製代碼

Sub ExcelSQL2()
Dim i&, j%
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String, FileName$
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim TimeInterval#
Dim Time0#
Dim StartTime, EndTime, TimeStr$
Set ws1 = Sheets("CT")
Set ws2 = Sheets("Temp")
ws2.Cells.Clear
FileName = ThisWorkbook.FullName
ws1.Select
' StartTime = #1/1/2015 12:00:01 AM#
' EndTime = #12/31/2030#
' StartTime = CDbl(StartTime)
' EndTime = CDbl(EndTime)
StartTime = "2015/01/01 00:00:01"
TimeInterval = 10 '間隔 10 分鐘
' Time0 = Timer
TimeStr = " format( iif(MINUTE([日期時間]) mod " & TimeInterval & " = 0,[日期時間], " & _
"DateAdd(""n"", " & TimeInterval & "-MINUTE([日期時間]) mod " & TimeInterval & _
" ,[日期時間])),""yyyy/mm/dd hh:mm"") "
'=== 處理數值欄位的每 10分鐘平均 ===========================
Set cnn = New ADODB.Connection
cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
cnn.ConnectionString = "Data Source=" & FileName & ";Extended Properties=""Excel 12.0 xml;HDR=Yes;"""
cnn.Open
SQL = "SELECT " + TimeStr + " as [DateTime], CTcode, " & _
"AVG([Volts]) as [avgVolt], AVG([Hz]) as [avgHz] " & _
" From [" & ws1.Name & "$] " & _
" Where [日期時間] >= #" & StartTime & "# " & _
" Group by " + TimeStr + " ,CTcode " & _
" Order by " + TimeStr + " ,CTcode"
Set rs = cnn.Execute(SQL)
With ws2
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1) = rs.Fields(i).Name
Next
.Cells(2, 1).CopyFromRecordset rs
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
' Debug.Print Timer - Time0
End Sub

複製代碼