12
返回列表 上一主題 發帖

[發問] VBA SQL 取得時間間隔 的其他欄位之平均值

Scott090

帖子
519 
主題
54 
精華
0 
積分
595 
點名
255  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
11# 跳轉到 »
發表於 2015-8-13 22:59 | 只看該作者
回復 10# GBKEE

謝謝超版
用你指導的方法不用 ThisworkBook.fullname，跑一次是約 11秒快了許多

另外請教，Excel 資料庫要新增一欄位，用了 Alter Table [CT$] add NewColumn char(10) 得到運算無效的信息
ADO 不支援 Alter TABLE 嗎?
不曉得問題在哪裡，敬請指導
  1. Sub ExcelAddColumn()
  2.     Dim SQL As String
  3.     Dim j%, r%
  4.     Dim cnn As ADODB.Connection
  5.     Dim rs As ADODB.Recordset
  6.     Dim ws As Worksheet
  7.    
  8.     Time0 = Timer
  9.     Set ws = ThisWorkbook.Sheets(1)
  10.     Set cnn = New ADODB.Connection
  11.    
  12.     With cnn
  13.             .Provider = "Microsoft.ACE.OLEDB.12.0"
  14.               .ConnectionString = "Extended Properties= Excel 12.0;" _
  15.                 & "Data Source=D:\VBA SQL.xlsm"
  16.         '建議不要 Source=" & ThisWorkbook.FullName 在這資料庫活頁簿中執行此巨集,很耗記憶體
  17.         '**********************************************************
  18. '        '2003版 引用：microsoft activex data objects 2.x library
  19. '        .Provider = "microsoft.jet.oledb.4.0"
  20. '        .ConnectionString = "Extended Properties= Excel 8.0;" _
  21. '        & "Data Source=D:\VBA SQL.xls"
  22. '        '建議不要 Source=" & ThisWorkbook.FullName 在這資料庫活頁簿中執行此巨集,很耗記憶體
  23.         .Open
  24.     End With
  25.    
  26.     SQL = "Alter Table [CT$] ADD NewColumn char(10)"   '要增加一欄位名稱
  27.    
  28. '' 出現"無效的運算" 錯誤
  29.     cnn.Execute SQL
  30.    
  31.     Set rs = New ADODB.Recordset
  32.    
  33.     SQL = "select * from [CT$] "
  34.     rs.Open SQL, cnn
  35.     Debug.Print rs.Fields.Count
  36.    
  37. End Sub
複製代碼

TOP

Scott090

帖子
519 
主題
54 
精華
0 
積分
595 
點名
255  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
12#
發表於 2015-8-23 10:55 | 只看該作者
回復 8# GBKEE


    以一個SQL敘述完成需求終於可以達成如下，供參考； 謝謝
  1. Sub ExcelSQL2()

  3.     Dim i&, j%
  4.     Dim cnn As ADODB.Connection
  5.     Dim rs As ADODB.Recordset
  6.     Dim SQL As String, FileName$
  7.     Dim ws1 As Worksheet
  8.     Dim ws2 As Worksheet
  9.     Dim TimeInterval#
  10.     Dim Time0#
  11.     Dim StartTime, EndTime, TimeStr$
  12.    
  13.     Set ws1 = Sheets("CT")
  14.     Set ws2 = Sheets("Temp")
  15.     ws2.Cells.Clear
  16.    
  17.     FileName = ThisWorkbook.FullName
  18.    
  19.     ws1.Select
  20. '    StartTime = #1/1/2015 12:00:01 AM#
  21. '    EndTime = #12/31/2030#
  22. '    StartTime = CDbl(StartTime)
  23. '    EndTime = CDbl(EndTime)
  24.     StartTime = "2015/01/01 00:00:01"
  25.    
  26.     TimeInterval = 10   '間隔 10 分鐘
  27.    
  28. '    Time0 = Timer
  29.     TimeStr = " format( iif(MINUTE([日期時間]) mod " & TimeInterval & " = 0,[日期時間], " & _
  30.                 "DateAdd(""n"", " & TimeInterval & "-MINUTE([日期時間]) mod " & TimeInterval & _
  31.                 " ,[日期時間])),""yyyy/mm/dd hh:mm"") "
  32.                
  33. '=== 處理數值欄位的每 10分鐘平均 ===========================
  34.     Set cnn = New ADODB.Connection
  35.         cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
  36.         cnn.ConnectionString = "Data Source=" & FileName & ";Extended Properties=""Excel 12.0 xml;HDR=Yes;"""
  37.         cnn.Open
  38.    
  39.       SQL = "SELECT " + TimeStr + " as [DateTime], CTcode, " & _
  40.                 "AVG([Volts]) as [avgVolt], AVG([Hz]) as [avgHz] " & _
  41.         " From [" & ws1.Name & "$] " & _
  42.         " Where [日期時間] >= #" & StartTime & "# " & _
  43.         " Group by " + TimeStr + " ,CTcode " & _
  44.         " Order by " + TimeStr + " ,CTcode"
  45.         
  46.     Set rs = cnn.Execute(SQL)
  47.    
  48.     With ws2
  49.         For i = 0 To rs.Fields.Count - 1
  50.             .Cells(1, i + 1) = rs.Fields(i).Name
  51.         Next
  52.         .Cells(2, 1).CopyFromRecordset rs
  53.     End With
  54.       
  55.     rs.Close
  56.     cnn.Close
  57.     Set rs = Nothing
  58.     Set cnn = Nothing
  59. '    Debug.Print Timer - Time0
  60. End Sub
複製代碼

TOP

        靜思自在 : 布施如播種，以歡喜心滋潤種子，才會發芽。
12
返回列表 上一主題