- 帖子
- 552
- 主題
- 3
- 精華
- 0
- 積分
- 578
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-2-8
- 最後登錄
- 2024-7-9
  
|
回復 5# colinyang
下面代碼摻雜著ADODB及SQL語言,若需求更多說明,請自行Google- Option Explicit
- Dim myCon As Object, myRs As Object, SQL$
- Private Sub ComboBox1_Click()
- ComboBox2.Clear
- ComboBox3.Clear
- '增加了ComboBox4.Value至 FROM的後面來切換工作表
- SQL = "SELECT 公私立" & _
- " FROM [" & ComboBox4.Value & "$]" & _
- " Where 區域 Like '" & ComboBox1.Value & "'" & _
- " GROUP BY 公私立;"
- Set myRs = myCon.Execute(SQL)
- ComboBox2.List = Application.Transpose(myRs.GetRows)
- End Sub
- Private Sub ComboBox2_Click()
- ComboBox3.Clear
- '增加了ComboBox4.Value至 FROM的後面來切換工作表
- SQL = "SELECT 學校" & _
- " FROM [" & ComboBox4.Value & "$]" & _
- " GROUP BY 學校, [區域] & [公私立]" & _
- " HAVING [區域] & [公私立] Like '" & ComboBox1.Value & ComboBox2.Value & "';"
- Set myRs = myCon.Execute(SQL)
- ComboBox3.List = Application.Transpose(myRs.GetRows)
- End Sub
- Private Sub ComboBox4_Change()
- ComboBox3.Clear
- ComboBox2.Clear
- ComboBox1.Clear
- SQL = "SELECT 區域" & _
- " FROM [" & ComboBox4.Value & "$]" & _
- " GROUP BY 區域;"
- Set myRs = myCon.Execute(SQL)
- ComboBox1.List = Application.Transpose(myRs.GetRows)
- Set myRs = Nothing
- End Sub
- Private Sub CommandButton1_Click() '輸人資料
- Dim ro
- With Sheets("工作表1")
- ro = .Cells(Rows.Count, 2).End(xlUp).Row + 1
- .Cells(ro, 2) = ComboBox1.Value
- .Cells(ro, 3) = ComboBox2.Value
- .Cells(ro, 4) = ComboBox3.Value
- End With
- ComboBox3.Clear
- ComboBox2.Clear
- ComboBox1.Clear
- ComboBox4.Value = ""
- End Sub
- Private Sub CommandButton2_Click() '離開
-
- Set myRs = Nothing
- myCon.Close
- Set myCon = Nothing
- Unload Me
- End Sub
- Private Sub UserForm_Initialize()
- Set myCon = CreateObject("ADODB.Connection")
- Set myRs = CreateObject("ADODB.Recordset")
- myCon.Open "provider=Microsoft.ACE.OLEDB.12.0;" & _
- "Data Source=" & ThisWorkbook.Path & "\data.xlsx;" & _
- "Extended Properties=""Excel 12.0;HDR=Yes;"";"
- ' 加入ComboBox4的Vlaue
- ComboBox4.AddItem "學校名單"
- ComboBox4.AddItem "學校名單2"
- End Sub
複製代碼 |
|