- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 7# Scott090
我使用2003版- 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
|
|
發表於 2015-7-29 07:53
| 