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

Question

我正在处理一个已导入并格式化到我的工作簿中的时间表。

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

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

我第一次尝试使用将数组分配给 currentregion 工作，但将所有列和字段都带入。Listbox1 应包含（ID、PHASE NAME、DURATION、START DATE、FINISH DATE）列表框 2 应在选择阶段时包含右侧列中的子任务（如果有），列在下一个阶段名称之前。 （ID、子任务名称、持续时间、开始日期、结束日期）

（见图）

我有代码，但它比实际的半工作脚本更多是我的故障排除。

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

那么我的问题是两个方面，试图使用动态范围或其他工具索引？收藏？填充第一个列表框。 2. 数据没有为组织目的分离时，如何处理空白和不连续的列。

Answer 1

我不知道我是否清楚你的意图。

1. 首先，从 listbox1 中只提取 b 列中的数据，而不是空单元格。
2. 其次，当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

结果图片

当您点击“KICKOFF”时，在listbox2中显示启动相关数据。