ExcelのVBAユーザーフォーム - スプレッドシートのデータエントリの行が一致しません

Question

VBAを使用して作成されたユーザーフォームがExcelシートの行に入力されています。それはありますが、彼らは一人です：

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

ジョーのレースは、代理店Bで黒とアジアです。ジョアンは白で、彼女は代理店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 

私はそれを修正する方法についてya'llが持っている任意のアイデアを大好きです！理想的には、それが次のいずれかの方法で出てくるでしょう：

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 

（私は2番目のを好むが、いずれかが動作します。）

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