[英]VBA UserForm in Excel--mismatched rows on spreadsheet data entry
我有一个通过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
(我更喜欢第二种,但是任何一种都可以。)
如果我能正确理解代码,则下面的重构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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.