Board logo

標題: [發問] 如何利用VBA對另個檔案的資料庫進行篩選，然後將選出的值存入表格中 [打印本頁]
作者: colinyang    時間: 2016-4-27 13:37     標題: 如何利用VBA對另個檔案的資料庫進行篩選，然後將選出的值存入表格中

個人對VBA較為生疏，但是目前功能函數已無法滿足，故發問前來求助個位VBA專家..
也希望藉此來提升自身VBA的程度，後續也會努力回饋各位的!!!

檔案有兩個
data.xlsx : 資料列表
[attach]24035[/attach]
list.xlsm : VBA的Form與紀錄區域
[attach]24037[/attach]

如果希望list.xlsm的ComboBox針對data.xlsx資料列表進行篩選
(類似自動篩選，彼此關係是連動的，根據範圍的選定後，後面可選的選項會縮小，例如北部/國立/A學校，南部/私立/H學校)
然後最後list.xlsm的三個ComboBox選定後再按輸入資料後，會輸入在list.xlsm的輸入資料欄位內，若上一列有資料則會繼續向下遞補

希望各位可以幫忙一下，感謝各位的協助，謝謝大家..[attach]24038[/attach]
作者: colinyang    時間: 2016-4-27 20:48

回復 1# colinyang

應該是說ComboBox比較像是連動選單，因為沒有要針對原始資料進行篩選，只有下拉式選單要資料連動而已..
不好意思..
作者: lpk187    時間: 2016-4-28 08:19

回復 2# colinyang

把程式碼貼到UserForm1中試試
  1. Option Explicit
  2. Dim myCon As Object, myRs As Object, SQL$
  3. Private Sub ComboBox1_Click()
  4.     ComboBox2.Clear
  5.     ComboBox3.Clear
  6.     SQL = "SELECT 公私立" & _
  7.           " FROM [學校名單$]" & _
  8.           " Where 區域 Like '" & ComboBox1.Value & "'" & _
  9.           " GROUP BY 公私立;"
  10.     Set myRs = myCon.Execute(SQL)
  11.     ComboBox2.List = Application.Transpose(myRs.GetRows)
  12. End Sub

  14. Private Sub ComboBox2_Click()
  15.     ComboBox3.Clear
  16.     SQL = "SELECT 學校" & _
  17.           " FROM [學校名單$]" & _
  18.           " GROUP BY 學校, [區域] & [公私立]" & _
  19.           " HAVING [區域] & [公私立] Like '" & ComboBox1.Value & ComboBox2.Value & "';"
  20.     Set myRs = myCon.Execute(SQL)
  21.     ComboBox3.List = Application.Transpose(myRs.GetRows)
  22. End Sub

  24. Private Sub CommandButton1_Click() '輸人資料
  25.     Dim ro
  26.     With Sheets("工作表1")
  27.         ro = .Cells(Rows.Count, 2).End(xlUp).Row + 1
  28.         .Cells(ro, 2) = ComboBox1.Value
  29.         .Cells(ro, 3) = ComboBox2.Value
  30.         .Cells(ro, 4) = ComboBox3.Value
  31.     End With
  32.     ComboBox3.Clear
  33.     ComboBox2.Clear
  34.     ComboBox1.Value = ""
  35. End Sub

  37. Private Sub CommandButton2_Click() '離開
  38.     Unload Me
  39. End Sub

  41. Private Sub UserForm_Initialize()
  42.     Set myCon = CreateObject("ADODB.Connection")
  43.     Set myRs = CreateObject("ADODB.Recordset")
  44.     myCon.Open "provider=Microsoft.ACE.OLEDB.12.0;" & _
  45.                "Data Source=" & ThisWorkbook.Path & "\data.xlsx;" & _
  46.                "Extended Properties=""Excel 12.0;HDR=Yes;"";"
  47.     SQL = "SELECT 區域" & _
  48.           " FROM [學校名單$]" & _
  49.           " GROUP BY 區域;"
  50.     Set myRs = myCon.Execute(SQL)
  51.     ComboBox1.List = Application.Transpose(myRs.GetRows)
  52.     Set myRs = Nothing
  53. '    myCon.Close
  54. '    Set myCon = Nothing
  55. End Sub
複製代碼
作者: colinyang    時間: 2016-4-28 10:54

回復 3# lpk187

實際測試，下拉選單與輸入皆無異常，這對我而言真的是一個經典的範例，真的十分的感謝
後續將會再進行分頁的增加再進行測試，好好解析一下程式碼了，若有任何問題會再與您請教
真的是太感謝了!!!
作者: colinyang    時間: 2016-4-29 20:08

回復 3# lpk187

Dear lpk187,

如果我的Data工作表再加入一個"學校名單2"
[attach]24099[/attach]
我在List在新增1個ComboBox4來進行切換作業
已在Form Initial的時候addItem進ComboBox4了
[attach]24100[/attach]
結果在SQL語法中利用"&"進行SQL字串與變數連接時，執行時卻造成以下異常，我該如何修正我的語法來達到變更的目的呢...
[attach]24101[/attach]

以下為程式碼，並附上檔案，還請您指教..謝謝
[attach]24102[/attach]
  1. Option Explicit
  2. Dim myCon As Object, myRs As Object, SQL$
  3. Private Sub ComboBox1_Click()
  4.     ComboBox2.Clear
  5.     ComboBox3.Clear
  6.     '增加了ComboBox4.Value至 FROM的後面來切換工作表
  7.     SQL = "SELECT 公私立" & _
  8.           " FROM [& ComboBox4.Value &$]" & _
  9.           " Where 區域 Like '" & ComboBox1.Value & "'" & _
  10.           " GROUP BY 公私立;"
  11.     Set myRs = myCon.Execute(SQL)
  12.     ComboBox2.List = Application.Transpose(myRs.GetRows)
  13. End Sub

  15. Private Sub ComboBox2_Click()
  16.     ComboBox3.Clear
  17.     '增加了ComboBox4.Value至 FROM的後面來切換工作表
  18.     SQL = "SELECT 學校" & _
  19.           " FROM [& ComboBox4.Value &$]" & _
  20.           " GROUP BY 學校, [區域] & [公私立]" & _
  21.           " HAVING [區域] & [公私立] Like '" & ComboBox1.Value & ComboBox2.Value & "';"
  22.     Set myRs = myCon.Execute(SQL)
  23.     ComboBox3.List = Application.Transpose(myRs.GetRows)
  24. End Sub

  26. Private Sub CommandButton1_Click() '輸人資料
  27.     Dim ro
  28.     With Sheets("工作表1")
  29.         ro = .Cells(Rows.Count, 2).End(xlUp).Row + 1
  30.         .Cells(ro, 2) = ComboBox1.Value
  31.         .Cells(ro, 3) = ComboBox2.Value
  32.         .Cells(ro, 4) = ComboBox3.Value
  33.     End With
  34.     ComboBox3.Clear
  35.     ComboBox2.Clear
  36.     ComboBox1.Value = ""
  37. End Sub

  39. Private Sub CommandButton2_Click() '離開
  40.     Unload Me
  41. End Sub

  43. Private Sub UserForm_Initialize()
  44.     Set myCon = CreateObject("ADODB.Connection")
  45.     Set myRs = CreateObject("ADODB.Recordset")
  46.     myCon.Open "provider=Microsoft.ACE.OLEDB.12.0;" & _
  47.                "Data Source=" & ThisWorkbook.Path & "\data.xlsx;" & _
  48.                "Extended Properties=""Excel 12.0;HDR=Yes;"";"
  49.     '增加了ComboBox4.Value至 FROM的後面來切換工作表
  50.     SQL = "SELECT 區域" & _
  51.           " FROM [& ComboBox4.Value &$]" & _
  52.           " GROUP BY 區域;"
  53.     Set myRs = myCon.Execute(SQL)
  54.     ComboBox1.List = Application.Transpose(myRs.GetRows)
  55.     Set myRs = Nothing
  56.    
  57. '   加入ComboBox4的Vlaue
  58.     ComboBox4.AddItem "學校名單"
  59.     ComboBox4.AddItem "學校名單2"
  60. '    myCon.Close
  61. '    Set myCon = Nothing
  62. End Sub
複製代碼
Best Regards,
Colin
作者: lpk187    時間: 2016-4-29 21:33

回復 5# colinyang

下面代碼摻雜著ADODB及SQL語言，若需求更多說明，請自行Google
  1. Option Explicit
  2. Dim myCon As Object, myRs As Object, SQL$
  3. Private Sub ComboBox1_Click()
  4.     ComboBox2.Clear
  5.     ComboBox3.Clear
  6.     '增加了ComboBox4.Value至 FROM的後面來切換工作表
  7.     SQL = "SELECT 公私立" & _
  8.           " FROM [" & ComboBox4.Value & "$]" & _
  9.           " Where 區域 Like '" & ComboBox1.Value & "'" & _
  10.           " GROUP BY 公私立;"
  11.     Set myRs = myCon.Execute(SQL)
  12.     ComboBox2.List = Application.Transpose(myRs.GetRows)
  13. End Sub

  15. Private Sub ComboBox2_Click()
  16.     ComboBox3.Clear
  17.     '增加了ComboBox4.Value至 FROM的後面來切換工作表
  18.     SQL = "SELECT 學校" & _
  19.           " FROM [" & ComboBox4.Value & "$]" & _
  20.           " GROUP BY 學校, [區域] & [公私立]" & _
  21.           " HAVING [區域] & [公私立] Like '" & ComboBox1.Value & ComboBox2.Value & "';"
  22.     Set myRs = myCon.Execute(SQL)
  23.     ComboBox3.List = Application.Transpose(myRs.GetRows)
  24. End Sub

  26. Private Sub ComboBox4_Change()
  27.     ComboBox3.Clear
  28.     ComboBox2.Clear
  29.     ComboBox1.Clear
  30.     SQL = "SELECT 區域" & _
  31.           " FROM [" & ComboBox4.Value & "$]" & _
  32.           " GROUP BY 區域;"
  33.     Set myRs = myCon.Execute(SQL)
  34.     ComboBox1.List = Application.Transpose(myRs.GetRows)
  35.     Set myRs = Nothing
  36. End Sub

  38. Private Sub CommandButton1_Click() '輸人資料
  39.     Dim ro
  40.     With Sheets("工作表1")
  41.         ro = .Cells(Rows.Count, 2).End(xlUp).Row + 1
  42.         .Cells(ro, 2) = ComboBox1.Value
  43.         .Cells(ro, 3) = ComboBox2.Value
  44.         .Cells(ro, 4) = ComboBox3.Value
  45.     End With
  46.     ComboBox3.Clear
  47.     ComboBox2.Clear
  48.     ComboBox1.Clear
  49.     ComboBox4.Value = ""
  50. End Sub

  52. Private Sub CommandButton2_Click() '離開
  53.    
  54.     Set myRs = Nothing
  55.     myCon.Close
  56.     Set myCon = Nothing
  57.     Unload Me
  58. End Sub

  60. Private Sub UserForm_Initialize()
  61.     Set myCon = CreateObject("ADODB.Connection")
  62.     Set myRs = CreateObject("ADODB.Recordset")
  63.     myCon.Open "provider=Microsoft.ACE.OLEDB.12.0;" & _
  64.                "Data Source=" & ThisWorkbook.Path & "\data.xlsx;" & _
  65.                "Extended Properties=""Excel 12.0;HDR=Yes;"";"
  66. '   加入ComboBox4的Vlaue
  67.     ComboBox4.AddItem "學校名單"
  68.     ComboBox4.AddItem "學校名單2"
  69. End Sub
複製代碼
作者: colinyang    時間: 2016-4-29 21:59

回復 6# lpk187
謝謝你，造成您的困擾了...抱歉
作者: Hsieh    時間: 2016-4-29 23:43

本帖最後由 Hsieh 於 2016-4-29 23:56 編輯

回復 2# colinyang

直覺是Combobox3清單會依據Combobox1，Combobox2內容變動
選定後按下按鈕依序輸入
  1. Public d2

  3. Private Sub ComboBox1_Change()
  4. ex
  5. End Sub

  7. Private Sub ComboBox2_Change()
  8. ex
  9. End Sub

  11. Private Sub ComboBox4_Change()
  12. Set d = CreateObject("Scripting.Dictionary")
  13. Set d1 = CreateObject("Scripting.Dictionary")
  14. Set d2 = CreateObject("Scripting.Dictionary")
  15. fs = ThisWorkbook.Path & "\data.xlsx" '請將2檔案放在同一目錄
  16. Set databook = Workbooks.Open(fs)
  17. With databook.Sheets(ComboBox4.Text)
  18. For Each a In .Range(.[A2], .[A2].End(xlDown))
  19.    d(a.Value) = "" 'A欄不重複清單
  20.    d1(a.Offset(, 1).Value) = "" 'B欄不重複清單
  21.    d2(a & a.Offset(, 1)) = IIf(d2(a & a.Offset(, 1)) = "", a.Offset(, 2), d2(a & a.Offset(, 1)) & "," & a.Offset(, 2)) 'A&B欄清單內容
  22. Next
  23. ComboBox1.List = d.keys
  24. ComboBox2.List = d1.keys
  25. End With
  26. databook.Close 0

  28. End Sub

  30. Private Sub CommandButton1_Click()
  31. Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(, 3) = Array(ComboBox1, ComboBox2, ComboBox3) '輸入資料
  32. End Sub

  34. Private Sub UserForm_Initialize()
  35. fs = ThisWorkbook.Path & "\data.xlsx" '請將2檔案放在同一目錄
  36. Set databook = Workbooks.Open(fs)
  37. For Each sh In databook.Sheets
  38.    ComboBox4.AddItem sh.Name
  39. Next
  40. databook.Close 0
  41. End Sub
  42. Sub ex()
  43. mystr = ComboBox1 & ComboBox2
  44. If d2(mystr) <> "" Then ComboBox3.List = Split(d2(mystr), ",") 'Combobox3的清單
  45. End Sub
複製代碼
作者: colinyang    時間: 2016-4-30 00:47

回復 8# Hsieh

謝謝版主，看起來又是另外一種方式來進行選取呢!會好好吸收的!不過在Combobox4選取時會有畫面更新的動作
加入Application.ScreenUpdating = False，可以抑止更新狀況，但是同樣輸入的時候資料不會浮現..必須重新打開檔案才看的到
但是程式碼還是很值得學習，謝謝呢!!!
作者: colinyang    時間: 2016-5-2 12:54

各位好..有發現個問題想問了..是關於資料有Null的部分
[attach]24132[/attach]
在轉換時因為會有字串與NULL的問題，所以轉換資料會出現異常
[attach]24133[/attach]
有查詢到SQL可使用CASE進行IS NOT NULL判讀..可是接著在CASE IS NOT NULL "WHEN"的時候
ADODB認不出WHEN的方法..請問該如何將NULL移除呢..謝謝



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)