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

如何解决在非连续范围内使用多个列表框

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

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

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

我的第一次尝试使用将数组分配给CurrentRegion，但带来了所有列和字段。listBox1应包含（ID，阶段名，持续时间，开始日期，完成日期）列表框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、当数据没有出于组织目的而分开时，如何处理空白和不连续的列。

解决方法

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

1. 首先，从 listbox1 中只提取 b 列中的数据，而不是空单元格。
2. Second,when listbox1 is selected,data related to listbox2 is collected through the selected listbox value.

模块代码

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

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,6) 'data colums A,C,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中显示与开球相关的数据。