Три каскадных комбо-бокса - PullRequest
Новая
       23

Три каскадных комбо-бокса

0 голосов
/ 24 октября 2018

У меня относительно большой объем данных, которые я пытаюсь преобразовать в три comboboxes в excel userform.В основном я пытаюсь создать систему заказов на покупку строительных товаров.Это включает три комбинированных списка, в основном разбитых на «Категория», «Подкатегория» и «Продукт».

Я нашел некоторый код, который использует функцию .offset, однако единственный способ, которым я нашел это, был очень трудоемким.Я очень новичок в VBA.

Есть ли способ использовать этот код или другой код для эффективной сортировки моих данных, вместо того, чтобы я каждый раз вручную менял смещение? 

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

Любая помощь будет отличной!

1 Ответ

0 голосов
/ 12 ноября 2018

Ускорьте его с помощью массива полей данных

Насколько я понял, ваша главная задача - добиться повышения скорости с помощью каскадных комбинированных списков в пользовательской форме и читаемого кода, избегая многочисленных .Offset.

[i.] Циклический просмотр диапазона всегда занимает много времени, быстрее позволяет назначить полный набор данных для варианта массива поля данных (myData) .

[ii.] Вызов одиночной вспомогательной процедуры fillComboNo делает _Change процедуры событий более читабельными .

[iii.]Дополнительная вспомогательная процедура SortColl сортирует каждой коллекции, чтобы сделать выбор удобной для пользователя .

[iv.] Кроме того, этот пример кода позволяет добавить еще больше комбинированных списков , используя ту же вспомогательную процедуру fillComboNo в дополнительных Combobox{No}_Change процедурах события.- Конечно, в этом случае необходимо будет расширить диапазон, назначенный массиву полей данных myData, тоже (т.е. с 3 столбцов A:C до, например, A:D) .

Пример кода

В основном это решение близко к вашему подходу, так как оно также использует коллекции.Он быстрее , так как использует массив полей данных, как описано выше; он не претендует на то, чтобы предлагать наиболее эффективный способ отображения каскадных комбинированных списков.

В этом примере предполагается, что перечисляются все необходимые комбинированные списки 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

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

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
...