使用单元格下拉列表中的值填充 vba ComboBox

Question

我想用在特定单元格中找到的下拉值填充 comboBox，比如 C10。

C10 使用 Excel 的数据验证功能将可输入单元格的值限制为下拉列表。 我想使用此列表在 vba 用户表单中填充 comboBox。

目前我的方法是使用：

Range("C10").Validation.Formula1

这是可以返回的 3 个任意示例：

1. “=制作”
2. "=INDIRECT(C9 & "_MK")"
3. “0;1;2;3;4;5;6;7;8;9;10”

我的方法是对此进行评估并尝试将其形成一个可用范围，该范围可用于设置我的 comboBox 的 RowSource 属性。 但是，我无法解释所有可以退回的可行案例。

当然，有一种简短而简单的方法可以实现我想要的，而无需为每种情况编写异常代码。

这样做的正确方法是什么？

Answer 1

但是，我无法解释所有可以退回的可行案例。

您将不得不单独考虑它。 没有直接的方法来获得这些值。

这是我编写的快速代码GetDVList() ，它将处理您的所有 3 个场景。

下面的代码将返回数组中的数据验证列表的值，您可以从中填充 Combobox。 我已经对代码进行了注释，因此您理解它应该没有问题，但是如果您这样做了，那么只需询问即可。

这是你正在尝试的吗？

Option Explicit

Sub Sample()
    Dim rng As Range
    Dim i As Long
    Dim cmbArray As Variant
    
    '~~> Change this to the relevant sheet and range
    Set rng = Sheet1.Range("A1")
    
    '~~> Check if range has data validation
    On Error Resume Next
    i = rng.SpecialCells(xlCellTypeSameValidation).Count
    On Error GoTo 0
    
    '~~> If no validation found then exit sub
    If i = 0 Then
        MsgBox "No validation found"
        Exit Sub
    End If
    
    '~~> The array of values
    cmbArray = GetDVList(rng)
    
    '~~> You can transfer these values to Combobox
    For i = LBound(cmbArray) To UBound(cmbArray)
        Debug.Print cmbArray(i)
    Next i
End Sub

Function GetDVList(rng As Range) As Variant
    Dim tmpArray As Variant
    Dim i As Long, rw As Long
    Dim dvFormula As String
    
    dvFormula = rng.Validation.Formula1
    
    '~~> "=Makes"
    '~~> "=INDIRECT(C9 &_MK)"
    If Left(dvFormula, 1) = "=" Then
        dvFormula = Mid(dvFormula, 2)
        
        rw = Range(dvFormula).rows.Count
        
        ReDim tmpArray(1 To rw)
        
        For i = 1 To rw
            tmpArray(i) = Range(dvFormula).Cells(i, 1)
        Next i
    '~~> "0;1;2;3;4;5;6;7;8;9;10"
    Else
        tmpArray = Split(dvFormula, ",") '~~> Use ; instead of , if required
    End If

    GetDVList = tmpArray
End Function

Answer 2

请测试下一个代码。 它适用于List Validation公式只能返回Range或列表（数组）的假设。 从理论上讲，它应该评估任何公式并提取它返回的内容，就Range或 List 而言：

Sub comboListValidation()
 Dim cel As Range, arr, arrV
 Dim cb As OLEObject  'sheet ActiveX combo
 
 Set cb = ActiveSheet.Shapes("ComboBox1").OLEFormat.Object
 
 Set cel = ActiveCell 'instead of active cell you can use what you need
                      'even a cell resulted from iteration between `sameValidation` range
 
 arrV = isCellVal(cel) 'check if chell has validadion (and DropDown type)
 If Not arrV(0) Then
    MsgBox "No validation for cell """ & cel.Address & """.": Exit Sub
 ElseIf Not arrV(1) Then
    MsgBox "cell """ & cel.Address & """ has validation but not DropDown type.": Exit Sub
 End If
 
 arr = listValidation_Array(cel)
 
 With cb.Object
    .Clear      'clear the existing items (if any)
    .list = arr 'load the combo using arr
 End With
 MsgBox "Did it..."
End Sub

Private Function listValidation_Array(cel As Range) As Variant
  Dim strForm As String, rngV As Range, strList As String, arr

  strForm = cel.Validation.Formula1         'extract Formula1 string
  On Error Resume Next
   Set rngV = Application.Evaluate(strForm) '!!!try setting the evaluated range!!!
   If Err.Number = 424 Then 'if not a Range, it must be a list (usually, comma separated)
        Err.Clear: On Error GoTo 0
        listValidation_Array = Split(Replace(strForm, ";", ","), ",") 'treat the ";" sep, too
   Else
        On Error GoTo 0
        listValidation_Array = rngV.Value   'extract the array from range
   End If
End Function

Function isCellVal(rng As Range) As Variant
 Dim VType As Long
 Dim boolValid As Boolean, boolDropDown As Boolean
 
 On Error Resume Next
  VType = rng.Validation.Type 'check if validation exists
 On Error GoTo 0

 If VType >= 1 Then           'any validation type
     boolValid = True
     If VType = 3 Then boolDropDown = True 'dropDown type
 End If
 ReDim arr(1) : arr(0) = boolValid: arr(1) = boolDropDown
 isCellVal = arr
End Function