Excel中的VBA用戶窗體-電子表格數據條目上的行不匹配

Question

我有一個通過VBA創建的用戶窗體，該窗體應該填充Excel工作表上的行。 確實可以，但是它們是一次性的：

Name   |   Race   |   Agency
           Black
Joe        Asian      B
           White
Joanne                C

喬的種族是B黑人種族和亞洲種族。 喬安妮（Joanne）是白人，她在C公司。不知何故，參賽作品錯開了。

名稱是文本框，種族和代理是列表框，種族是多選，代理是單選。

這是我的代碼：

Private Sub CommandButton1_Click()
Dim j As Long
Dim i As Integer
With ListBox2
ReDim arr(.ListCount - 1)
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
        .Selected(i) = False
        arr(j) = .List(i)
        j = j + i
        End If
    Next i
End With
ReDim Preserve arr(j)
With ActiveSheet
.Range("B" & .Rows.Count).End(xlUp). _
Offset(1, 0).Resize(j + 1, 1).Value = Application.Transpose(arr)
End With
i = 1
While ThisWorkbook.Worksheets("Sheet1").Range("B" & i).Value <> ""
i = i + 1
Wend
ThisWorkbook.Worksheets("Sheet1").Range("A" & i).Value = TextBox1.Value
ThisWorkbook.Worksheets("Sheet1").Range("C" & i).Value = ListBox1.Value
End Sub
Private Sub CommandButton2_Click()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
    Select Case TypeName(ctl)
        Case "TextBox"
            ctl.Text = ""
        Case "CheckBox", "OptionButton", "ToggleButton"
            ctl.Value = False
        Case "ComboBox", "ListBox"
            ctl.ListIndex = -1
    End Select
Next ctl
End Sub
Sub UserForm_Initialize()
ListBox1.List = Array("A", "B", "C")
With ListBox2
  .Clear
  .AddItem "White"
  .AddItem "Black"
  .AddItem "Asian"
  .AddItem "Am Indian/Al Native"
  .AddItem "Native Hawaiian/Pac Islander"
  .AddItem "Other"
End With
End Sub

我希望您有解決該問題的任何想法！ 理想情況下，它將以下列方式之一出現：

Name   |   Race   |   Agency
Joe        Black      B
           Asian      B
Joanne     White      C

要么

Name   |   Race          |   Agency
Joe        Black, Asian      B
Joanne     White             C

要么

Name   |   Race   |   Agency
Joe        Black      B
Joe        Asian      B
Joanne     White      C

（我更喜歡第二種，但是任何一種都可以。）

Answer 1

如果我能正確理解代碼，則下面的重構CommandButton1_Click過程應該為您提供首選的結果。

Private Sub CommandButton1_Click()

Dim j As Long
Dim i As Integer

'load races into array
With ListBox2

    ReDim arr(.ListCount - 1)

    For i = 0 To .ListCount - 1

        If .Selected(i) = True Then
            .Selected(i) = False
            arr(j) = .List(i)
            j = j + i
        End If

    Next i

End With

ReDim Preserve arr(j)

'build "," separated string of races
For i = LBound(arr) To UBound(arr)

    Dim sRace As String
    sRace = sRace & "," & arr(i)

Next
sRace = Mid(sRace, 2) 'to remove first comma

'place info on next available line in sheet.
With ThisWorkbook.Worksheets("Sheet1")

    Dim lRow As Long
    lRow = .Range("A" & .Rows.Count).End(xlUp).Offset(1).Row

    .Range("A" & lRow).Value = TextBox1.Value
    .Range("B" & lRow).Value = sRace
    .Range("C" & lRow).Value = ListBox1.Value

End With

End Sub