三个级联组合框 [英] Three cascading Comboboxes

问题描述

我要在 excel userform 中将相对大量的数据转换为三个 combobox .基本上，我正在尝试为建筑产品创建采购订单系统.这涉及三个组合框，基本上分为类别"，子类别"和产品".

I have a relatively large amount of data that I am trying to convert into three comboboxes in an excel userform. Basically I am trying to create a purchase order system for construction products. This involves the three comboboxes, basically broken down into "Category", "Sub Category" and "Product".

我发现一些使用 .offset 函数的代码，但是我发现使用此代码的唯一方法非常耗时.我是VBA的新手.

I found some code that uses the .offset function, however the only way I found to use this was very time consuming. I am very new to VBA.

有没有一种方法可以使用此代码或其他代码对我的数据进行有效排序，而不是每次都手动更改偏移量?

Is there a way to use this code or another code to effectively sort through my data rather than me manually changing the offset each time?

Private Sub UserForm_Initialize()

Dim ws As Worksheet
Dim LR As Long
Dim Cell As Range
Dim List As New Collection
Dim Item As Variant
Set ws = ActiveSheet

With ws
LR = Sheet1.Cells(.Rows.Count, 1).End(xlUp).Row
For Each Cell In .Range("A2:A" & LR)
    With Cell
        On Error Resume Next
        List.Add .Text, CStr(.Value)
        On Error GoTo 0
    End With
Next Cell
For Each Item In List
    ComboBox1.AddItem Item
    Next Item
End With
End Sub

Private Sub ComboBox1_Change()

Dim ws As Worksheet
Dim LR As Long
Dim Cell As Range
Dim List As New Collection
Dim Item As Variant
Set ws = ActiveSheet


With ws
    LR = Sheet1.Cells(.Rows.Count, 1).End(xlUp).Row
    ComboBox2.Clear
    For Each Cell In .Range("A2:A" & LR)
        With Cell
            If .Text = ComboBox1.Value Then
                On Error Resume Next
                List.Add .Offset(0, 1).Text, CStr(.Offset(0, 1).Value)
                On Error GoTo 0
            End If
        End With
    Next Cell
    For Each Item In List
        ComboBox2.AddItem Item
    Next Item
End With


End Sub

Private Sub ComboBox2_Change()

Dim ws As Worksheet
Dim LR As Long
Dim Cell As Range
Dim List As New Collection
Dim Item As Variant
Set ws = ActiveSheet

With ws
    LR = Sheet1.Cells(.Rows.Count, 1).End(xlUp).Row
    ComboBox3.Clear
    For Each Cell In .Range("A2:A" & LR)
        With Cell
            If .Text = ComboBox1.Value Then
                If .Offset(0, 1).Text = ComboBox2.Value Then
                On Error Resume Next
                List.Add .Offset(0, 2).Text, CStr(.Offset(0, 2).Value)
                On Error GoTo 0
            End If
        End If
        End With
    Next Cell
    For Each Item In List
        ComboBox3.AddItem Item
    Next Item
End With

End Sub

任何帮助都会很棒！

推荐答案

使用数据字段数组加快速度

据我了解，您主要关心的是使用UserForm中的级联组合框和可读代码来避免许多 .Offset 的情况下提高速度.

As far as I understood, your main concern is to achieve improved speed using cascading comboboxes in a UserForm and readable code avoiding numerous .Offset .

[i.]遍历一个范围总是很费时，将您的完整数据集分配给 variant 数据字段数组(myData ).

[i.] Looping through a range is always time consuming, it's faster to assign your complete data set to a variant datafield array (myData).

[ii.]调用单个帮助程序 fillComboNo 使 _Change 事件过程更具可读性.

[ii.] Calling a single helper procedure fillComboNo makes the _Change event procedures more readable.

[iii.]附加帮助程序 SortColl 对进行分类以使选择用户友好.

[iii.] The additional helper procedure SortColl sorts each collection to make selections user friendly.

[iv.]此外，此示例代码还允许在其他 Combobox中使用相同的帮助程序 fillComboNo 添加 更多组合框{No} _Change 事件过程.-当然，在这种情况下，有必要将分配给数据字段数组 myData 的范围也扩展为(即从3列 A:C 扩展到例如 A:D ).

[iv.] Furthermore this example code allows to add even more comboboxes using the same helper procedure fillComboNo in additional Combobox{No}_Change event procedures. - Of course, in this case it would be necessary to extend the range assigned to the datafield array myData, too (i.e. from 3 columns A:C to e.g. A:D).

示例代码

基本上，此解决方案也与您的方法很接近，因为它也使用集合.它更快，因为它使用了如上所述的数据字段数组；它并不假装提供最有效的方式来显示级联组合框.

Basically this solution is close to your approach as it uses collections, too. It is faster as it uses a datafield array as described above; it does not pretend to offer the most efficient way to show cascading comboboxes.

此示例假定已枚举所有所需的ComboBox， ComboBox1 ， ComboBox2 ， ComboBox3 ，...

This example assumes that all needed ComboBoxes are enumerated ComboBox1, ComboBox2, ComboBox3, ...

Option Explicit                                     ' declaration head of the UserForm code module
Dim myData                                          ' Variant 2-dim datafield array ( 1-based !)

Private Sub UserForm_Initialize()
  Dim LR   As Long, ws As Worksheet
  Set ws = Sheet1                                   ' if using CodeName in thisWorkbook
' ~~~~~~~~~~~~~~~~~~~~~~~~~
' [0] get entire DATA FIELD                         ' e.g. columns A:C (omitting title row)
' ~~~~~~~~~~~~~~~~~~~~~~~~~
  LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row     ' get last row
  myData = ws.Range("A2:C" & LR).Value2             ' <<  assign range values to datafield array

' [1] fill first ComboBox
  FillComboNo 1                                     ' <~~ helper procedure FillComboNo
End Sub

Private Sub ComboBox1_Change()
    FillComboNo 2                                   ' <~~ helper procedure FillComboNo
End Sub

Private Sub ComboBox2_Change()
    FillComboNo 3                                   ' <~~ helper procedure FillComboNo
End Sub

帮助程序 FillComboNo

Helper procedure FillComboNo

Sub FillComboNo(ByVal no As Long)
' Purpose: fill cascading comboboxes
' Note:    assumes controls named as "ComboBox" & No (ComboBox1, ComboBox2, ...)
Dim myList As New Collection
Dim item   As Variant
Dim i      As Long, ii As Long
Dim OK     As Boolean, OKTemp As Boolean
' [0] clear ComboBox{No}
  Me.Controls("ComboBox" & no).Clear
' [1] assign values in column No based on prior hierarchy levels
  For i = LBound(myData) To UBound(myData)
    ' [1a] check upper hierarchy
      OK = True
      For ii = 1 To no - 1
          OKTemp = myData(i, ii) = Me.Controls("ComboBox" & ii): OK = OK And OKTemp
      Next ii
    ' [1b] add to collection
      If OK Then
         On Error Resume Next
         myList.Add myData(i, no), myData(i, no)
         If Err.Number <> 0 Then Err.Clear
      End If
  Next i
' [1c] sort collection via helper procedure
      SortColl myList                               ' <~~ helper procedure SortColl
' [2] fill ComboBox{No}
  For Each item In myList
      Me.Controls("ComboBox" & no).AddItem item
  Next item
End Sub

排序例程 SortColl

Sorting routine SortColl

Sub SortColl(ByRef c As Collection)
' Purpose: sort collection by keys via bubble sort method
  Dim i     As Long, j As Long
  Dim vTemp As Variant
  For i = 1 To c.Count - 1
      For j = i + 1 To c.Count
          If c(i) > c(j) Then
            ' remember the lesser item
              vTemp = c(j)
            ' remove the lesser item
              c.Remove j
            ' add the lesser item before the greater one
              c.Add vTemp, vTemp, i
          End If
      Next j
  Next i
End Sub

这篇关于三个级联组合框的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！