VBA 使用Excel資料庫:行轉列
阿新 • • 發佈:2019-01-02
最近工作中有需求,要從Excel表中提取一些統計資訊,因為需求變動可能比較頻繁,所以用VBA來做了。除錯資料操作部分頗費周折,特記錄一下。
1.資料來源檔案:[D:\4月份統計表.xlsx]:
2.最終的統計表格式:
3.計算規則:
要求:
A. 外觀等級A,且WLD在451.5-458之間,且LOP在82-200之間判定為OK,其他為NG。
B.將NG的按照表面等級→WLD→LOP的優先順序,判定是哪一項引起的不良,更新到資料來源的 [篩選結果] 中。
C.在統計表中按照入庫日期分組,統計總數量、OK數量、NG數量,以及NG產品中外觀等級、WLD、LOP各佔多大比例。
4.程式碼:
說明:Option Explicit Public Sub DataInquire() Dim strCnn As String, sqlStr As String, subSqlStr As String, strSql(1 To 4) As String '判斷條件 1=OK,2=外觀等級NG,3=WLDNG,4=LOPNG Dim MainBook As Workbook Dim Arr() As Variant, rngA As Range, rngB As Range Dim cnn As Object, rs As Object Dim i As Long, itemStr(1 To 4) As String '判定標誌 1=OK,2=外觀等級,3=WLD,4=LOP Dim sourceFile As String Set cnn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") Set MainBook = ThisWorkbook sourceFile = "D:\4月份統計表.xlsx" strCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" + sourceFile + "';Extended Properties='Excel 12.0;HDR=YES,IME=1'" With ThisWorkbook.Worksheets(1) strSql(1) = " And [外觀等級] ='A' And [WLD] >=451.5 And [WLD] <=458 And LOP>=82 And LOP<200" strSql(2) = " And [外觀等級] <>'A'" strSql(3) = " And ([WLD] <451.5 or [WLD] >458)" strSql(4) = " And (LOP>=82 or LOP<200" itemStr(1) = "OK" itemStr(2) = "外觀等級" itemStr(3) = "WLD" itemStr(4) = "LOP" Set rngA = .Range("B" & .Cells(6000, "B").End(xlUp).Row + 1).Resize(1, 12) '//找到寫資料的位置 End With cnn.Open strCnn If cnn.State = 1 Then For i = 4 To 1 Step -1 '//更新篩選結果 sqlStr = "update [資料來源$] set [篩選結果]= '" & itemStr(i) & "' where 1=1 " & strSql(i) cnn.Execute sqlStr Next i '//////Excel/Access不支援case when then end結構,要用IIF來代替//// ' subSqlStr = "(select [序號], case [篩選結果] when 'OK' then 1 end as [OK]," & _ ' " case [篩選結果] when '外觀等級' then 1 end as [外觀等級]," & _ ' " case [篩選結果] when 'WLD' then 1 end as [WLD]," & _ ' " case [篩選結果] when 'LOP' then 1 end as [LOP]," & _ ' " from [資料來源$]) B " ' /////////////////////////////////////////////////////////////////// subSqlStr = "(select [襯底編號], iif( [篩選結果] = 'OK',1,0 ) as [OK]," & _ " iif( [篩選結果] = '外觀等級',1,0 ) as [外觀等級]," & _ " iif( [篩選結果] = 'WLD',1,0 ) as [WLD]," & _ " iif( [篩選結果] = 'LOP',1,0 ) as [LOP]," & _ " from [資料來源$]) B " sqlStr = "select A.[入庫日期],count(A.[入庫日期]) as 總數量,sum(B.[OK]) as OK,(count(A.[入庫日期])-sum(B.[OK])) as NG,sum(B.[外觀等級])/(count(A.[入庫日期])-sum(B.[OK]))," & _ " sum(B.[WLD])/(count(A.[入庫日期])-sum(B.[OK])),sum(B.[LOP])/(count(A.[入庫日期])-sum(B.[OK]))" & _ "from [資料來源$] A, " & subSqlStr & " where A.[序號]=B.[序號] " & _ "group by A.[入庫日期] order by A.[入庫日期] asc" Set rs = cnn.Execute(sqlStr) If Not rs.EOF Then Arr = WorksheetFunction.Transpose(rs.GetRows()) Set rngA = rngA.Resize(UBound(Arr, 1), 12) rngA = Arr rngA.Borders.LineStyle = xlContinuous rngA.Resize(, 1).Offset(, 4).Resize(, 8).NumberFormatLocal = "0.00%" End If Set rs = Nothing End If cnn.Close End Sub
A.要將[篩選結果]做細項分析,就要用到行轉列。而Excel/Access中沒有case when then end 結構,更沒有pivot可以用,幸好有IIF可用。
B.Transpose函式使用有些限制,要求結果集不超過1024行[未驗證],且結果集不包含null[已驗證]。
C.Excel作為資料庫,查詢速度明顯比Access資料庫以及SqlServer、Oracle速度慢很多。5萬多行資料,要查詢大約20秒了。
D.Excel表作為資料庫使用,select和update可正常使用,但insert和delete不能用。使用select into 可以建立新的Excel工作表。