運用VBA抓取SQL的資料到EXCEL裡(一)

最近在學習用.NET從SQL抓資料丟進EXCEL或WORD裡進行另存新檔和列印的技巧，稍微有些心得，不過尚未整理完畢，不過從.NET去撈SQL的資料再丟進EXCEL裡的動作，對於單純用在SELECT資料並且只是運用在簡單的處理上，效能與速度反而不如直接從EXCEL裡運用VBA去作同樣的動作，雖然感覺起來都是同樣的動作，但是實際上，我在實例經驗裡直接用EXCEL處理量大的資料，速度快上很多，在這邊對於這個技巧稍作點紀錄。以下是最近實作的例子。

實例一(住診會診)：統計些住診會診的資料
打開EXCEL檔後，會看到如下圖的介面，其中部份欄位為保密資料已清除資料，剩下的部份可見到一個Button鈕，由於這個例子是在辦公室完成，然而這次紀錄是在家裡作的，前者是使用office2003以前的版本，家裡則是使用office2007的版本，有些功能在2007裡我也不太知道被放到那邊去了，大至上紀錄些關鍵步驟與最重要的VBA「程式碼」。

1.要從SQL撈出如下的資料，先點選巨集，放置一個Button於sheet3上，並且開啟設計模式，雙擊button進入vba編輯區，sheet3是上圖，也是我們主要的控制頁面，而sheet1與sheet2則是拿來放兩份從SQL撈出來的資料table，等等再在前面的excel作運算匯整成sheet3。

2.以這個例子看，主要有程式的地方有兩處，分別為主要頁面的sheet3與一個自己加的Module1(模組)。

先看sheet3的程式碼

  '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim strDate As String, endDate As String, strCell As String
Dim iDolrPos As Integer, lDataRows As Long
　　Sheets("Sheet3").Select
　　strDate = Right("00000" & Trim(Range("C3").Value), 7)
　　endDate = Right("00000" & Trim(Range("C4").Value), 7)

　　Range("E5").Font.Color = vbRed
　　Range("E5").Font.Bold = True
　　Range("E5").Value = "讀取高壓氧收入資料，請稍候!!"
　　lDataRows = querydata(strDate, endDate)


　　Worksheets("Sheet3").Select
　　Range("A7").Select

　　If lDataRows > 0 Then
　　　　Range("A8:M30000").Clear

　　　　Range("A8").Formula = "=Sheet1!A8"
　　　　Range("B8").Formula = "=Sheet1!B8"
　　　　Range("C8").Formula = "=Sheet1!C8"
　　　　Range("D8").Formula = "=VLOOKUP(Sheet1!D8,Sheet2!醫師查詢,2,FALSE)"
　　　　Range("E8").Formula = "=VLOOKUP(Sheet1!E8,Sheet2!科別查詢,2,FALSE)"
　　　　Range("F8").Formula = "=Sheet1!F8"
　　　　Range("G8").Formula = "=VLOOKUP(Sheet1!G8,Sheet2!醫師查詢,2,FALSE)"
　　　　Range("H8").Formula = "=VLOOKUP(Sheet1!H8,Sheet2!科別查詢,2,FALSE)"
　　　　Range("I8").Formula = "=Sheet1!I8"
　　　　Range("J8").Formula = "=IF(Sheet1!J8=""會"",Sheet1!J8,""尚未會診"")"
　　　　Range("A8:J8").Copy Destination:=Range("A9:A" + CStr(lDataRows + 6))

　　Else
　　　　MsgBox ("資料查詢結果有誤，請洽資訊室!")
　　End If
　　Range("E5").Value = "資訊查查詢完畢!!!!! "

End Sub
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------

再看Module1的程式碼

'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function querydata(strDate, endDate) As Long
　　Dim lDataRows As Long
　　Sheets("Sheet1").Select
　　Range("A7").Select
　　Selection.QueryTable.Connection = "ODBC;DRIVER=SQL Server;SERVER=\\test\testsql;UID=userid;PWD=password;APP=Microsoft Office 2003"
　　Selection.QueryTable.CommandType = xlCmdSql
　　Selection.QueryTable.CommandText = _
　　Array("SELECT 語法" & Chr(10) & Chr(13) _)

　　　　Selection.QueryTable.Refresh BackgroundQuery:=False

　　　　lDataRows = Range("住院查詢").Rows.Count

　　Sheets("Sheet2").Select
　　Range("B1").Value = Format(Now, "YYYY/MM/DD")
　　If Range("A1").Value <> Range("B1").Value Then
　　　　Range("Sheet2!A7").Select
　　　　Selection.QueryTable.Connection = "ODBC;DRIVER=SQL Server;SERVER=\\test\testsql;UID=userid;PWD=password;APP=Microsoft Office 2003"
　　　　Selection.QueryTable.CommandType = xlCmdSql
　　　　Selection.QueryTable.CommandText = _
　　　　Array("SELECT 語法" & Chr(10) & Chr(13) _)

　　　　Selection.QueryTable.Refresh BackgroundQuery:=False

　　　　　　　　Range("Sheet2!H7").Select
　　　　Selection.QueryTable.Connection = "ODBC;DRIVER=SQL Server;SERVER=\\11.11.11.11;UID=1111;PWD=11111;APP=Microsoft Office 2003"
　　　　Selection.QueryTable.CommandType = xlCmdSql
　　　　Selection.QueryTable.CommandText = _
　　　　Array("SELECT 語法" & Chr(10) & Chr(13) _)

　　　　Selection.QueryTable.Refresh BackgroundQuery:=False


　　　　Range("A1").Value = Format(Now, "YYYY/MM/DD")
　　End If
　　querydata = lDataRows
End Function
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------

淡紅色：連接SQL用，相關SQL訊息
紅色：運用SQL的SELECT語法，並將結果放在一個暫存TABLE裡

暫存於此...

程式碼欄位