在不连续的范围内使用多个列表框

Question

我正在使用我已导入并格式化到我的工作簿中的时间表。

我希望它在上层列表框中填充阶段，然后选择一个阶段时，与这些阶段关联的sub-task显示在底部列表框中。

我想使用数组，但当列彼此不相邻或空白单元格存在“间隙”时，我似乎遇到了问题。

我第一次尝试将数组分配给当前区域，但成功了，但将所有列和字段都带入了列表框 1 应包含（ID、阶段名称、持续时间、开始日期、结束日期）列表框 2 应在选择阶段时包含包含右侧列中的子任务（如果有），列在下一个下一个阶段名称之前。（ID，SUB-TASK 姓名，持续时间，开始日期，结束日期）

（见图）

我有代码，但它比实际的半工作脚本更重要 trouble-shooting。

Dim shT As Worksheet
Dim schnumrng1 As Range
Dim schnumrng2 As Range
Dim schnumrng3 As Range
Dim schnumrng4 As Range
Dim schnumrng5 As Range
Dim schpersonrng As Range
Dim schphaserng As Range
Dim schlistrng As Range
Dim maxschnum
Dim schstatus
Dim schperson
Dim schlistnum
Dim Ar() As String
Dim i As Long
Dim j As Long
Dim rng As Range
Dim cl As Range
Dim lc

'allowevents = True


''Set Screen parameters
'Application.ScreenUpdating = False
'Application.EnableEvents = False
'
Worksheets("Schedule").Visible = True
ThisWorkbook.Worksheets("Schedule").Activate
'
Set shT = Worksheets("Schedule")
 maxschnum = shT.Cells(shT.Rows.Count, "A").End(xlUp).Row
 Set schnumrng = Range("B5", "B" & maxschnum)
 
 'Set Ranges for the list box
Set schnumrng1 = Range("A5", "A" & maxschnum)
Set schnumrng2 = Range("B5", "B" & maxschnum)
Set schnumrng3 = Range("D5", "D" & maxschnum)
Set schnumrng4 = Range("E5", "E" & maxschnum)
Set schnumrng5 = Range("F5", "F" & maxschnum)

 
'This is static and not moving to the next line in my for statement / switched to named ranges and errors
Set rng = schnumrng1, schnumrng2, schnumrng3, schnumrng4, schnumrng5
'Set rng = Range("A5,B5,D5,E5,F5")

    i = 1
    j = 1
For Each lc In schnumrng
    If lc <> vbNullString Then
        For Each cl In rng
            ReDim Preserve Ar(1, 1 To i)
            Ar(j, i) = cl.Value
            
            i = i + 1
            Next cl
        Else
        End If
        j = j + 1
Next lc

    With ScheduleForm.SchMainTasklt
        .ColumnCount = i - 1
        .ColumnWidths = "50;150;50;50;50"
        .List = Ar
    End With

我的问题是双重的，尝试使用动态范围或其他工具索引？ collection？填充第一个列表框。 2. 为组织目的不分隔数据时，如何处理空白和不连续的列。

Answer 1

不知道有没有看懂你的用意

首先，从 listbox1 中仅提取 b 列中的数据，不提取空单元格。
其次，选中listbox1时，通过选中的listbox值收集listbox2相关的数据。

模块代码

将此代码放入模块中。这是因为必须使用全局变量。

Public vDB As Variant
Public Dic As Object 'Dictionary
Sub test()
    Dim shT As Worksheet
    Dim maxschnum As Long
    Dim Ar() As String
    Dim i As Long
    Dim j As Long
    
    Dim vC() As Variant
    Dim cnt As Integer, n As Integer
    Dim c As Integer
    Dim s As String, s2 As String
    


    Worksheets("Schedule").Visible = True
    ThisWorkbook.Worksheets("Schedule").Activate
    '
    Set Dic = CreateObject("Scripting.Dictionary")  'New Scripting.Dictionary
    
    Set shT = Worksheets("Schedule")
    
    
    maxschnum = shT.Cells(shT.Rows.Count, "A").End(xlUp).Row
    With shT
        vDB = .Range("a5", .Range("f" & maxschnum))
    End With
    
    'vC is data colum A,B,D,E,F
    vC = Array(1, 2, 4, 5, 6)
    
    s2 = vDB(2, 2)
    For i = 2 To UBound(vDB, 1)
        s = vDB(i, 2) 'column B
        If s = "" Then
            n = n + 1
        Else
            If Dic.Exists(s) Then
            Else
                If i > 2 Then
                    Dic(s2) = Dic(s2) & "," & n
                End If
                
                Dic.Add s, i
                s2 = s
                cnt = cnt + 1
                ReDim Preserve Ar(1 To 5, 1 To cnt)
                For c = 0 To UBound(vC)
                    Ar(c + 1, cnt) = vDB(i, vC(c))
                Next c
            End If
            n = 0
        End If
    Next i
    Dic(s2) = Dic(s2) & "," & n
    
    ' Records information about the data in a dictionary.
    ' Dic is "phase neme" is Key, Item is "2,4"
    ' example for KICkOFF
    ' dic key is "KICKOFF",  Item is "5,4"
    '   5 is KICOFF's row number in array vDB
    '   4 is the number of blank cells related to kickoff.

    
        With ScheduleForm.SchMainTasklt
            .ColumnCount = 5
            .ColumnWidths = "50;150;50;60;60"
            .BoundColumn = 2
            '.List = Ar
            .Column = Ar 'In the state that the array has been converted to row column, you can use listbox.column.
        End With
End Sub

表单代码

Private Sub UserForm_Initialize()
    
    Call test

End Sub
Private Sub SchMainTasklt_Click()
    Dim s As String, sItem As String
    Dim arr As Variant, vC As Variant
    Dim vR() As Variant
    Dim st As Long, ed As Long
    Dim iLast As Long, iFirst As Long
    Dim i As Long, n As Integer
    Dim j As Integer
    
    vC = Array(1, 3, 4, 5, 6) 'data colums A,C,D,E,F
    s = SchMainTasklt.Value
    'MsgBox s
    
    sItem = Dic(s)
    arr = Split(sItem, ",")
    
    st = Val(arr(0))
    ed = Val(arr(1))
    
    iFirst = st + 1
    iLast = st + ed
    
    If ed = 0 Then
        MsgBox "no data!!"
        Exit Sub
    End If
    
    For i = iFirst To iLast
        n = n + 1
        ReDim Preserve vR(1 To 5, 1 To n)
        For j = 0 To UBound(vC)
            vR(j + 1, n) = vDB(i, vC(j))
        Next j
    Next i
    With ListBox2
        .ColumnCount = 5
        .ColumnWidths = "50;150;50;60;60"
        .BoundColumn = 2
        .Column = vR
    End With

End Sub

结果图片

当你点击“开球”时，在listbox2中显示开球相关数据。

在不连续的范围内使用多个列表框

Using multiple listbox in noncontiguous ranges

vba

dynamic

listbox

模块代码

表单代码

结果图片