具有多个列表框的 For 循环

For loop with multiple listboxes

我从 Excel post 先生那里提取了代码,并尝试将其重新用于多个列表框。

我希望输入的数据根据​​不同的变量跨越多行。
那就是让它把列表框下选中的各种组合排成一行。

图片link:https://imgur.com/a/cWcDwNx
我想要屏幕截图 1 中的选项到 return 屏幕截图 2,但 returns 屏幕截图 3.
我想要屏幕截图 4 中的选项到 return 屏幕截图 5,但 returns 屏幕截图 6.

Private Sub CommandButton1_Click()

    Dim rng As Range
    Dim i As Long
    Dim A As Long
    
    Set rng = Range("A" & Rows.Count).End(xlUp).Offset(1)
    
    For A = 0 To ListBox2.ListCount - 1

        If ListBox2.Selected(A) = True Then
            rng.Resize(, 5).Value = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value, ListBox2.List(A))
            Set rng = rng.Offset(1)
        End If

        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                rng.Resize(, 5).Value = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value, ListBox1.List(i), ListBox2.List(A))
                Set rng = rng.Offset(1)
            End If
        Next i

    Next A

End Sub


Private Sub UserForm_Initialize()

    With ListBox1
        .List = Array("A", "B", "C")
        .ListStyle = fmListStyleOption
        .MultiSelect = fmMultiSelectMulti
    End With

    With ListBox2
        .List = Array("Kappa", "Keepo")
        .ListStyle = fmListStyleOption
        .MultiSelect = fmMultiSelectMulti
    End With

End Sub

我哪里出错了,是语法还是整个方法?
如何对多个列表框执行此操作,甚至可能是 4 个?

您需要嵌套循环(未测试)

Private Sub CommandButton1_Click()

    Dim rng As Range,  i As Long, j  As Long, ar 

    Set rng = Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 5)
    
    ar = Array(TextBox1.Value,TextBox2.Value,TextBox3.Value,"","")

    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ar(3) = ListBox1.List(i)

            For j = 0 To ListBox2.ListCount - 1
                If ListBox2.Selected(j) = True Then
                    ar(4) = ListBox2.List(j)

                    rng.Value = ar
                    Set rng = rng.Offset(1)

                End If
            Next
        End If
    Next
End Sub