如何动态获取数据到组合框答案

【问题标题】：How to dynamically fetch data to combo box如何动态获取数据到组合框
【发布时间】：2021-04-30 02:21:50
【问题描述】：

我无法根据 Drop down 1 将数据提取到 Drop down

下拉 1 -> 将获取 NAME 详细信息

下拉 2 -> 将获取 AGE 详细信息

下拉 3 -> 将获取课程详情

我尝试获取数据的方式是

如果 Dropdown 1 -> 我选择了值：A，那么 Dropdown 2 的值应该会自动获取，Dropdown 3 也会自动获取

下拉菜单 2 将具有以下值

并且 Dropdown 3 应该获取值

MCA
MBA
MMS
BAF
BMS
BBM

如果我选择 Dropdown 1 -> Value -> B Dropdown 2 和 Dropdown 3 应该会自动获取值

因此，在选择 Dropdown 1 -> B 时，应自动为 Dropdown 2 和 Dropdown 3 填充以下值

并且 Dropdown 2 应该获取值

并且 Dropdown 3 应该获取值

MBBS
CDAC
DD
SF

我已经尝试过这段代码，但没有工作？我是 vba 编码的新手

Private Sub cmbabc()
Me.cmbabc.Clear

Dim sh = As Worksheet 
Set sh = Sheets("Sheet1")

Dim i As Long
For i=2 To sh.Range("A1000").End(xlUp).Row
If sh.Cells(i,1)= Me.cmbabc.value Then
If Application.WorksheetFunction.Count if (sh.Range("B2","B" & i), sh.Cells(i,2) =1 Then
Me.Worksheet.AddItem sh.Cells(i,2)
End if 

End if 

Next i

End Sub

我的 excel 表 1 中的数据如下

【问题讨论】：

从下拉菜单 2 中选择时是否要更改下拉菜单 3（反之亦然）？
@Tim Williams 是的，选择下拉列表 2 -> 下拉列表 3 应该填充该列中的值，它们的值是什么
发布示例数据时，方便我们：发布为文本

标签： excel vba

【解决方案1】：

如果您的组合框命名为 cmbAbc for NAME， cmbAge for AGE， cmbCourse for COURSE，我们可以使用 Excel VBA 查询容量和 ADODB.Recordset，如下所示：

' query Excel sheet:
'
' strColumnName: Excel column name to query
' strWhere: where string
' xarr: array to return and then used as ComboBox list
'
Function queryExcel4ColumName(ByVal strColumnName, ByVal strWhere)
  Dim lLastRow As Long
  Dim strRange

  Dim strCon As String, strFile As String, strSQL As String
  Dim cnn As ADODB.Connection
  Dim rst As ADODB.Recordset
  Dim i As Long, xarr

  strFile = ThisWorkbook.FullName
  strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

  Set cnn = CreateObject("ADODB.Connection")
  Set rst = CreateObject("ADODB.Recordset")

  cnn.Open strCon

'
  lLastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).row
  strRange = "Sheet1$A1:C" & lLastRow

' query a Range:
  strSQL = "SELECT DISTINCT " & strColumnName _
    & " FROM [" & strRange & "]"

' add WHERE clause if not null:
  If (strWhere <> "") Then
    strSQL = strSQL _
      & " WHERE " & strWhere
  End If

  rst.Open strSQL, cnn

  i = 0
  While (Not rst.EOF)
    If (i = 0) Then
      ReDim xarr(i)
    Else
      ReDim Preserve xarr(i)
    End If
    xarr(i) = rst(0).Value
    rst.MoveNext
    i = i + 1
  Wend

  rst.Close
  Set rst = Nothing
  Set cnn = Nothing
  queryExcel4ColumName = xarr
End Function

Private Sub cmbAbc_Change()
  Me.cmbAge.List = queryExcel4ColumName("AGE", "NAME='" & Me.cmbAbc.Value & "'")
  Me.cmbCourse.List = queryExcel4ColumName("COURSE", "NAME='" & Me.cmbAbc.Value & "'")
End Sub

Private Sub UserForm_Initialize()
  Me.cmbAbc.List = queryExcel4ColumName("NAME", "")
End Sub

这段代码都在 UserForm1 Private Module 中。当 UserForm_Initialize() 时，我们从 Sheet1 中使用的范围中加载所有不同的名称。

在 Sheet1 中，我们使用第 1 行作为列名，它们是 [NAME]、[AGE] 和 [COURSE]。

当 cmbAbc_Change() 时，我们分别为 cmbAge 和 cmbCourse 加载相应的不同 AGE 和 COURSE。

也请咨询https://stackoverflow.com/a/915297/953097。

【讨论】：