動態欄位對映設計

問題: 如果用迴圈從資料庫寫資料到Excel儲存格,碰到客戶要求插入某欄位或欄位挪移的需求時,將會很麻煩.

說明: 麻煩在需更改程式,如果是插入欄位,需將插入位置右方儲存格順移,這時需找出所有對映寫法的區域,然後小心變更欄位對映的儲存格.

範例:如下迴圈為常用寫法,如果客戶要求在I格左邊插入一個新欄位.

'處理所有產品迴圈,原程式
For li_this = 1 To li_rc
　ls_row=trim(string(li_this))
　Worksheets("Sheet1").Range("H" + ls_row).Value = getitem(lole_localord.getitemstring(li_this, "order_item_buyer_itemno"))
　Worksheets("Sheet1").Range("I" + ls_row).Value = getitem(lole_localord.getitemstring(li_this, "item_c10"))
　Worksheets("Sheet1").Range("J" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e09"))
　Worksheets("Sheet1").Range("K" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e17"))
　Worksheets("Sheet1").Range("L" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e15"))
　Worksheets("Sheet1").Range("M" + ls_row).Value = getitem(lole_localord.getitemstring(li_this, "buyer_inout_unit"))
　Worksheets("Sheet1").Range("N" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e16"))
　Worksheets("Sheet1").Range("O" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_cbm"))
　Worksheets("Sheet1").Range("P" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "order_item_num"))
next

---

'處理所有產品迴圈,修改後程式,紅色為插入欄位
For li_this = 1 To li_rc
　ls_row=trim(string(li_this))
　Worksheets("Sheet1").Range("H" + ls_row).Value = getitem(lole_localord.getitemstring(li_this, "order_item_buyer_itemno"))
　Worksheets("Sheet1").Range("I" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e21"))
　Worksheets("Sheet1").Range("J" + ls_row).Value = getitem(lole_localord.getitemstring(li_this, "item_c10"))
　Worksheets("Sheet1").Range("K" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e09"))
　Worksheets("Sheet1").Range("L" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e17"))
　Worksheets("Sheet1").Range("M" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e15"))
　Worksheets("Sheet1").Range("N" + ls_row).Value = getitem(lole_localord.getitemstring(li_this, "buyer_inout_unit"))
　Worksheets("Sheet1").Range("O" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_e16"))
　Worksheets("Sheet1").Range("P" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "buyer_item_cbm"))
　Worksheets("Sheet1").Range("Q" + ls_row).Value = getnumber(lole_localord.GetItemNumber(li_this, "order_item_num"))
next

---

更頭痛的是如果來個欄位乾坤大挪移,那核對這些儲存格與資料欄位的關係,可就會很傷眼傷神了.

如果Excel 檔還需支援比對與回寫資料庫的功能,那呼叫對映欄位的區段就會有好幾個,核對的工作就更繁雜.

觀察對映的寫法,可以發現儲存格位置是字元+列座標,列座標為迴圈指標,而資料來源分不同型態用不同取值函數
1.日期 getitemdate()
2.字串 getitemstring()
3.數值 getitemnumber()

只要找出固定規則重覆性,就可寫一個函數取代迴圈內的對映程式碼區段.這種寫法可以適用於所有用到資料庫欄位對映儲存格的VBA巨集程式.其好處為
pg_use可開放MIS維護,舉凡增減欄位或對調欄位,都只要維護此頁工作表即可,不需改VBA程式.


Call get_celldata '先將放在Excel檔pg_use頁的對映欄位關係存入矩陣
for li_this=1 to li_rc
　Call get_data(ls_row, "lole_localord", lole_localord, li_this) '由pg_use工作表當劇本展開客戶產品資料
next

---

函數get_data()會到矩陣找出所以欄位對映於儲存格的關係,然後依序將資料值填入儲存格位置
'由pg_use工作表當劇本展開資料
'針對指定的列位置,逐一到每個欄位取出值並放到對應的Excel格放置
Sub get_data(ls_row As String, lole_name As String, lole_standard As Object, li_datarow As Integer)
　Dim i As Integer, j As Integer, li_loop As Integer
　li_loop = 1

　i = 0
　j = 0
　Do
　　If cellpos(i, 0) = "" Then '如果矩陣cellpos(i, 0)= Table名稱沒了則停掉迴圈
　　　li_loop = 0
　　Else

　　　'矩陣cellpos(i, 4)=是否要自動取值展開,矩陣cellpos(i, 5)=retrieve ole=讀資料的datastore來源OLE資料物件名稱
　　　'因為矩陣放的不只一個datastore來源OLE資料物件名稱,所以需比對是否為指定的OLE
　　　If cellpos(i, 4) = "Y" And cellpos(i, 5) = lole_name Then
　　　　'透過 lole_standard,cellpos(i, 1)=retrieve dwo欄位 可以向datastore取資料
　　　　'透過 cellpos(i, 0)=table,cellpos(i, 1)=retrieve dwo欄位,可以找到Excel格放資料
　　　　Call getdata(lole_standard, cellpos(i, 0), "sheet1", ls_row, cellpos(i, 1), cellpos(i, 3), li_datarow)
　　　End If
　　End If
　　i = i + 1
　Loop While li_loop = 1
End Sub

---

函數getdata會自動依照pg_use設定的形態,分配不同取值函數取值

'通用向指定的OLE datastore物件取指定欄位值的函數,並直接放到指定的工作表與儲存格
Public Sub getdata(mole As Object, mgroup As String, msheet As String, mrow As String, mcolumn As String, mtype As String, mdatarow As Integer)
　Dim mrange As String
　mrange = get_cell(mgroup, mcolumn) '先透過參數找出Excel格
　If Trim(mrange) = "" Then
　　MsgBox "datawindow=" & mgroup & " mcolumn=" & mcolumn
　　Exit Sub
　End If
　'將值放到 Excel 格
　If mtype = "S" Then
Worksheets(msheet).Range(mrange + mrow).Value = mole.Describe("evaluate('" + mcolumn + "'," & mdatarow & ")")
ElseIf mtype = "N" Then
Worksheets(msheet).Range(mrange + mrow).Value = mole.Describe("evaluate('" + mcolumn + "'," & mdatarow & ")")
ElseIf mtype = "D" Then
Worksheets(msheet).Range(mrange + mrow).Value = mole.GetItemDate(mdatarow, mcolumn)
End If
End Sub

---

函數get_cell()為取儲存格坐標用


'到矩陣找指定的table與欄位的對應Excel格
'將幾個常用的欄位與儲存格對應關係存到矩陣,以免都需要到pg_use工作表找
Public Function get_cell(mgroup As String, mcolumn As String)
　Dim i As Integer, j As Integer, li_loop As Integer, ls_value As String, ls_row
　Dim mcell As String
　mcell = "BX"
　li_loop = 1

　'到矩陣翻找欄位 --> 對應的Excel儲存格
　li_loop = 1
　i = 0
　j = 0
　Do
　　If cellpos(i, 0) = mgroup And cellpos(i, 1) = mcolumn Then
　　　mcell = cellpos(i, 2)
　　　li_loop = 0
　　End If
　　i = i + 1
　Loop While li_loop = 1 And i <= 100 '預設不會超過100格儲存格
　get_cell = mcell
　If mcell = "BX" Then '不會超過BX,若迴圈跑完仍找不到則儲存格=BX沒變
　　MsgBox "group=" & mgroup & " column=" & mcolumn & " 查無對應儲存格,請通知志翔科技"
　End If

End Function

---

函數get_calldata()為將pg_use頁的對映關係存到矩陣

Sub get_celldata()
　Dim i As Integer, j As Integer, li_loop As Integer, ls_row As String, ls_value As String
　i = 0
　j = 0
　Windows("IP.xls").Activate
　li_loop = 1
　Do
　　ls_row = Trim(Str(i + 1))
　　ls_value = Worksheets("pg_use").Range("A" + ls_row).Value
　　If Trim(ls_value) = "" Then
　　　　li_loop = 0
　　Else
　　　cellpos(i, 0) = Trim(Worksheets("pg_use").Range("A" + ls_row).Value) 'Table名稱
　　　cellpos(i, 1) = Trim(Worksheets("pg_use").Range("B" + ls_row).Value) 'retrieve dwo欄位=自讀取的datastore要取資料的版面欄位名稱
　　　cellpos(i, 2) = Trim(Worksheets("pg_use").Range("C" + ls_row).Value) '對應的Excel儲存格
　　　cellpos(i, 3) = Trim(Worksheets("pg_use").Range("F" + ls_row).Value) '欄位資料型態
　　　cellpos(i, 4) = Trim(Worksheets("pg_use").Range("H" + ls_row).Value) '是否要自動取值展開
　　　cellpos(i, 5) = Trim(Worksheets("pg_use").Range("I" + ls_row).Value) 'retrieve ole=讀資料的datastore來源OLE資料物件名稱

　　End If
　 　i = i + 1
　Loop While li_loop = 1

End Sub