VBA Excel 超过 10 列的列表框,从其他列表框填充值
VBA Excel more than 10 column ListBox, Populate values from other listbox
目前我正在并排填充 2 个列表框以提供有关用户表单的信息,然后将其填充到 SQL 数据库 table.
我需要将 2 个 ListBox 变成一个多列列表框,但有 20 列。
这是填充 2 个列表框的当前代码:
Private Sub AddActualRecord()
ListCount = frmRecordActuals.lstDirectTasks.ListCount
frmRecordActuals.lstDirectTasks.AddItem
frmRecordActuals.lstDirectTasks.list(ListCount, 0) = lstWorkItems.list(lstWorkItems.ListIndex, 0)
frmRecordActuals.lstDirectTasks.list(ListCount, 1) = txtPcId.value
frmRecordActuals.lstDirectTasks.list(ListCount, 2) = txtDirectActivityName.value
frmRecordActuals.lstDirectTasks.list(ListCount, 3) = lstWorkItems.list(lstWorkItems.ListIndex, 1)
frmRecordActuals.lstDirectTasks.list(ListCount, 4) = lstWorkItems.list(lstWorkItems.ListIndex, 2)
frmRecordActuals.lstDirectTasks.list(ListCount, 5) = lstWorkItems.list(lstWorkItems.ListIndex, 3)
frmRecordActuals.lstDirectTasks.list(ListCount, 6) = lstWorkItems.list(lstWorkItems.ListIndex, 6)
frmRecordActuals.lstDirectTasks.list(ListCount, 7) = lstWorkItems.list(lstWorkItems.ListIndex, 4)
frmRecordActuals.lstDirectTasks.list(ListCount, 8) = lstWorkItems.list(lstWorkItems.ListIndex, 5)
frmRecordActuals.lstDirectTasks.list(ListCount, 9) = lstProcessStage.list(lstProcessStage.ListIndex, 1)
ListCount2 = frmRecordActuals.lstDirectTasks2.ListCount
frmRecordActuals.lstDirectTasks2.AddItem
frmRecordActuals.lstDirectTasks2.list(ListCount2, 0) = lstProcessStage.list(lstProcessStage.ListIndex, 0)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 1) = cboGrade.list(cboGrade.ListIndex, 1)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 2) = cboGrade.list(cboGrade.ListIndex, 0)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 3) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 1)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 4) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 0)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 5) = cboHours.value
frmRecordActuals.lstDirectTasks2.list(ListCount2, 6) = cboMinutes.value
frmRecordActuals.lstDirectTasks2.list(ListCount2, 7) = lblHasCasesID.Caption
If lblHasCasesID.Caption = 1 Then
frmRecordActuals.lstDirectTasks2.list(ListCount2, 8) = txtSelected.value
Else: frmRecordActuals.lstDirectTasks2.list(ListCount2, 8) = "N/A"
End If
If lblHasCasesID.Caption = 1 Then
frmRecordActuals.lstDirectTasks2.list(ListCount2, 9) = txtDeselected.value
Else: frmRecordActuals.lstDirectTasks2.list(ListCount2, 9) = "N/A"
End If
End Sub
如有任何帮助,我们将不胜感激。
我见过各种解决方案,但不知道如何使它们适合。
编辑:这是用一个列表框替换 2 个列表框。
我想完全删除旧的 2 个列表框,让所有数据只转到 1 个新的 20 列列表框。
每次此代码 运行 都需要向列表框中添加另一行。但不是在循环中。代码需要能够 运行 多次并每次添加一个新行。
谢谢
编辑 2:
我已经更新了现在插入所有值的代码,但是每次代码为 运行.
时,这段代码都会简单地覆盖列表框中的第一行
如何修改代码,以便在再次 运行 时填充下一行?
非常感谢。
Private Sub AddActualRecord()
ListCount = frmRecordActuals.lstDirectTasks.ListCount
Dim DirectActual(ListCount, 20) As String
DirectActual(ListCount, 0) = lstWorkItems.list(lstWorkItems.ListIndex, 0)
DirectActual(ListCount, 1) = txtPcId.value
DirectActual(ListCount, 2) = txtDirectActivityName.value
DirectActual(ListCount, 3) = lstWorkItems.list(lstWorkItems.ListIndex, 1)
DirectActual(ListCount, 4) = lstWorkItems.list(lstWorkItems.ListIndex, 2)
DirectActual(ListCount, 5) = lstWorkItems.list(lstWorkItems.ListIndex, 3)
DirectActual(ListCount, 6) = lstWorkItems.list(lstWorkItems.ListIndex, 6)
DirectActual(ListCount, 7) = lstWorkItems.list(lstWorkItems.ListIndex, 4)
DirectActual(ListCount, 8) = lstWorkItems.list(lstWorkItems.ListIndex, 5)
DirectActual(ListCount, 9) = lstProcessStage.list(lstProcessStage.ListIndex,1)
DirectActual(ListCount, 10) = lstProcessStage.list(lstProcessStage.ListIndex, 0)
DirectActual(ListCount, 11) = cboGrade.list(cboGrade.ListIndex, 1)
DirectActual(ListCount, 12) = cboGrade.list(cboGrade.ListIndex, 0)
DirectActual(ListCount, 13) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 1)
DirectActual(ListCount, 14) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 0)
DirectActual(ListCount, 15) = cboHours.value
DirectActual(ListCount, 16) = cboMinutes.value
DirectActual(ListCount, 17) = lblHasCasesID.Caption
If lblHasCasesID.Caption = 1 Then
DirectActual(ListCount, 18) = txtSelected.value
Else: DirectActual(ListCount, 18) = "N/A"
End If
If lblHasCasesID.Caption = 1 Then
DirectActual(ListCount, 19) = txtDeselected.value
Else: DirectActual(ListCount, 19) = "N/A"
End If
With frmRecordActuals.lstDirectTasks
.ColumnCount = 12
.list = DirectActual
End With
End Sub
请测试下一个代码。当然没有测试,但它应该可以工作:
Private Sub AddActualRecord()
Dim ListCount As Long
ListCount = frmRecordActuals.lstDirectTasks.ListCount
If ListCount = 0 Then
Dim DirectActual(ListCount, 20) As String
DirectActual(ListCount, 0) = lstWorkItems.list(lstWorkItems.ListIndex, 0)
DirectActual(ListCount, 1) = txtPcId.value
DirectActual(ListCount, 2) = txtDirectActivityName.value
DirectActual(ListCount, 3) = lstWorkItems.list(lstWorkItems.ListIndex, 1)
DirectActual(ListCount, 4) = lstWorkItems.list(lstWorkItems.ListIndex, 2)
DirectActual(ListCount, 5) = lstWorkItems.list(lstWorkItems.ListIndex, 3)
DirectActual(ListCount, 6) = lstWorkItems.list(lstWorkItems.ListIndex, 6)
DirectActual(ListCount, 7) = lstWorkItems.list(lstWorkItems.ListIndex, 4)
DirectActual(ListCount, 8) = lstWorkItems.list(lstWorkItems.ListIndex, 5)
DirectActual(ListCount, 9) = lstProcessStage.list(lstProcessStage.ListIndex, 1)
DirectActual(ListCount, 10) = lstProcessStage.list(lstProcessStage.ListIndex, 0)
DirectActual(ListCount, 11) = cboGrade.list(cboGrade.ListIndex, 1)
DirectActual(ListCount, 12) = cboGrade.list(cboGrade.ListIndex, 0)
DirectActual(ListCount, 13) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 1)
DirectActual(ListCount, 14) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 0)
DirectActual(ListCount, 15) = cboHours.value
DirectActual(ListCount, 16) = cboMinutes.value
DirectActual(ListCount, 17) = lblHasCasesID.Caption
If lblHasCasesID.Caption = 1 Then
DirectActual(ListCount, 18) = txtSelected.value
Else
DirectActual(ListCount, 18) = "N/A"
End If
If lblHasCasesID.Caption = 1 Then
DirectActual(ListCount, 19) = txtDeselected.value
Else
DirectActual(ListCount, 19) = "N/A"
End If
With frmRecordActuals.lstDirectTasks
.ColumnCount = 12
.list = DirectActual
End With
Else
Dim arrList, arrFin, i As Long, j As Long, k As Long
arrList = frmRecordActuals.lstDirectTasks.list 'extract the list box elements in an array
ReDim arrFin(0 To UBound(arrList) + 1, 0 To UBound(arrList, 2)) 'redim the final array
For i = 0 To UBound(arrList) 'load the existing elements in the final array
For j = 0 To UBound(arrList, 2)
arrFin(k, j) = arrList(i, j)
Next j
k = k + 1
Next i
'add the new elements in the final array:
arrFin(k, 0) = lstWorkItems.list(lstWorkItems.ListIndex, 0)
arrFin(k, 1) = txtPcId.value
arrFin(k, 2) = txtDirectActivityName.value
arrFin(k, 3) = lstWorkItems.list(lstWorkItems.ListIndex, 1)
arrFin(k, 4) = lstWorkItems.list(lstWorkItems.ListIndex, 2)
arrFin(k, 5) = lstWorkItems.list(lstWorkItems.ListIndex, 3)
arrFin(k, 6) = lstWorkItems.list(lstWorkItems.ListIndex, 6)
arrFin(k, 7) = lstWorkItems.list(lstWorkItems.ListIndex, 4)
arrFin(k, 8) = lstWorkItems.list(lstWorkItems.ListIndex, 5)
arrFin(k, 9) = lstProcessStage.list(lstProcessStage.ListIndex, 1)
arrFin(k, 10) = lstProcessStage.list(lstProcessStage.ListIndex, 0)
arrFin(k, 11) = cboGrade.list(cboGrade.ListIndex, 1)
arrFin(k, 12) = cboGrade.list(cboGrade.ListIndex, 0)
arrFin(k, 13) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 1)
arrFin(k, 14) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 0)
arrFin(k, 15) = cboHours.value
arrFin(k, 16) = cboMinutes.value
arrFin(k, 17) = lblHasCasesID.Caption
If lblHasCasesID.Caption = 1 Then
arrFin(k, 18) = txtSelected.value
Else
arrFin(k, 18) = "N/A"
End If
If lblHasCasesID.Caption = 1 Then
arrFin(k, 19) = txtDeselected.value
Else
arrFin(k, 19) = "N/A"
End If
'load the listbox with the cumulated array:
frmRecordActuals.lstDirectTasks.list = arrFin
End If
End Sub
目前我正在并排填充 2 个列表框以提供有关用户表单的信息,然后将其填充到 SQL 数据库 table.
我需要将 2 个 ListBox 变成一个多列列表框,但有 20 列。
这是填充 2 个列表框的当前代码:
Private Sub AddActualRecord()
ListCount = frmRecordActuals.lstDirectTasks.ListCount
frmRecordActuals.lstDirectTasks.AddItem
frmRecordActuals.lstDirectTasks.list(ListCount, 0) = lstWorkItems.list(lstWorkItems.ListIndex, 0)
frmRecordActuals.lstDirectTasks.list(ListCount, 1) = txtPcId.value
frmRecordActuals.lstDirectTasks.list(ListCount, 2) = txtDirectActivityName.value
frmRecordActuals.lstDirectTasks.list(ListCount, 3) = lstWorkItems.list(lstWorkItems.ListIndex, 1)
frmRecordActuals.lstDirectTasks.list(ListCount, 4) = lstWorkItems.list(lstWorkItems.ListIndex, 2)
frmRecordActuals.lstDirectTasks.list(ListCount, 5) = lstWorkItems.list(lstWorkItems.ListIndex, 3)
frmRecordActuals.lstDirectTasks.list(ListCount, 6) = lstWorkItems.list(lstWorkItems.ListIndex, 6)
frmRecordActuals.lstDirectTasks.list(ListCount, 7) = lstWorkItems.list(lstWorkItems.ListIndex, 4)
frmRecordActuals.lstDirectTasks.list(ListCount, 8) = lstWorkItems.list(lstWorkItems.ListIndex, 5)
frmRecordActuals.lstDirectTasks.list(ListCount, 9) = lstProcessStage.list(lstProcessStage.ListIndex, 1)
ListCount2 = frmRecordActuals.lstDirectTasks2.ListCount
frmRecordActuals.lstDirectTasks2.AddItem
frmRecordActuals.lstDirectTasks2.list(ListCount2, 0) = lstProcessStage.list(lstProcessStage.ListIndex, 0)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 1) = cboGrade.list(cboGrade.ListIndex, 1)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 2) = cboGrade.list(cboGrade.ListIndex, 0)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 3) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 1)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 4) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 0)
frmRecordActuals.lstDirectTasks2.list(ListCount2, 5) = cboHours.value
frmRecordActuals.lstDirectTasks2.list(ListCount2, 6) = cboMinutes.value
frmRecordActuals.lstDirectTasks2.list(ListCount2, 7) = lblHasCasesID.Caption
If lblHasCasesID.Caption = 1 Then
frmRecordActuals.lstDirectTasks2.list(ListCount2, 8) = txtSelected.value
Else: frmRecordActuals.lstDirectTasks2.list(ListCount2, 8) = "N/A"
End If
If lblHasCasesID.Caption = 1 Then
frmRecordActuals.lstDirectTasks2.list(ListCount2, 9) = txtDeselected.value
Else: frmRecordActuals.lstDirectTasks2.list(ListCount2, 9) = "N/A"
End If
End Sub
如有任何帮助,我们将不胜感激。
我见过各种解决方案,但不知道如何使它们适合。
编辑:这是用一个列表框替换 2 个列表框。
我想完全删除旧的 2 个列表框,让所有数据只转到 1 个新的 20 列列表框。
每次此代码 运行 都需要向列表框中添加另一行。但不是在循环中。代码需要能够 运行 多次并每次添加一个新行。
谢谢
编辑 2:
我已经更新了现在插入所有值的代码,但是每次代码为 运行.
时,这段代码都会简单地覆盖列表框中的第一行如何修改代码,以便在再次 运行 时填充下一行?
非常感谢。
Private Sub AddActualRecord()
ListCount = frmRecordActuals.lstDirectTasks.ListCount
Dim DirectActual(ListCount, 20) As String
DirectActual(ListCount, 0) = lstWorkItems.list(lstWorkItems.ListIndex, 0)
DirectActual(ListCount, 1) = txtPcId.value
DirectActual(ListCount, 2) = txtDirectActivityName.value
DirectActual(ListCount, 3) = lstWorkItems.list(lstWorkItems.ListIndex, 1)
DirectActual(ListCount, 4) = lstWorkItems.list(lstWorkItems.ListIndex, 2)
DirectActual(ListCount, 5) = lstWorkItems.list(lstWorkItems.ListIndex, 3)
DirectActual(ListCount, 6) = lstWorkItems.list(lstWorkItems.ListIndex, 6)
DirectActual(ListCount, 7) = lstWorkItems.list(lstWorkItems.ListIndex, 4)
DirectActual(ListCount, 8) = lstWorkItems.list(lstWorkItems.ListIndex, 5)
DirectActual(ListCount, 9) = lstProcessStage.list(lstProcessStage.ListIndex,1)
DirectActual(ListCount, 10) = lstProcessStage.list(lstProcessStage.ListIndex, 0)
DirectActual(ListCount, 11) = cboGrade.list(cboGrade.ListIndex, 1)
DirectActual(ListCount, 12) = cboGrade.list(cboGrade.ListIndex, 0)
DirectActual(ListCount, 13) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 1)
DirectActual(ListCount, 14) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 0)
DirectActual(ListCount, 15) = cboHours.value
DirectActual(ListCount, 16) = cboMinutes.value
DirectActual(ListCount, 17) = lblHasCasesID.Caption
If lblHasCasesID.Caption = 1 Then
DirectActual(ListCount, 18) = txtSelected.value
Else: DirectActual(ListCount, 18) = "N/A"
End If
If lblHasCasesID.Caption = 1 Then
DirectActual(ListCount, 19) = txtDeselected.value
Else: DirectActual(ListCount, 19) = "N/A"
End If
With frmRecordActuals.lstDirectTasks
.ColumnCount = 12
.list = DirectActual
End With
End Sub
请测试下一个代码。当然没有测试,但它应该可以工作:
Private Sub AddActualRecord()
Dim ListCount As Long
ListCount = frmRecordActuals.lstDirectTasks.ListCount
If ListCount = 0 Then
Dim DirectActual(ListCount, 20) As String
DirectActual(ListCount, 0) = lstWorkItems.list(lstWorkItems.ListIndex, 0)
DirectActual(ListCount, 1) = txtPcId.value
DirectActual(ListCount, 2) = txtDirectActivityName.value
DirectActual(ListCount, 3) = lstWorkItems.list(lstWorkItems.ListIndex, 1)
DirectActual(ListCount, 4) = lstWorkItems.list(lstWorkItems.ListIndex, 2)
DirectActual(ListCount, 5) = lstWorkItems.list(lstWorkItems.ListIndex, 3)
DirectActual(ListCount, 6) = lstWorkItems.list(lstWorkItems.ListIndex, 6)
DirectActual(ListCount, 7) = lstWorkItems.list(lstWorkItems.ListIndex, 4)
DirectActual(ListCount, 8) = lstWorkItems.list(lstWorkItems.ListIndex, 5)
DirectActual(ListCount, 9) = lstProcessStage.list(lstProcessStage.ListIndex, 1)
DirectActual(ListCount, 10) = lstProcessStage.list(lstProcessStage.ListIndex, 0)
DirectActual(ListCount, 11) = cboGrade.list(cboGrade.ListIndex, 1)
DirectActual(ListCount, 12) = cboGrade.list(cboGrade.ListIndex, 0)
DirectActual(ListCount, 13) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 1)
DirectActual(ListCount, 14) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 0)
DirectActual(ListCount, 15) = cboHours.value
DirectActual(ListCount, 16) = cboMinutes.value
DirectActual(ListCount, 17) = lblHasCasesID.Caption
If lblHasCasesID.Caption = 1 Then
DirectActual(ListCount, 18) = txtSelected.value
Else
DirectActual(ListCount, 18) = "N/A"
End If
If lblHasCasesID.Caption = 1 Then
DirectActual(ListCount, 19) = txtDeselected.value
Else
DirectActual(ListCount, 19) = "N/A"
End If
With frmRecordActuals.lstDirectTasks
.ColumnCount = 12
.list = DirectActual
End With
Else
Dim arrList, arrFin, i As Long, j As Long, k As Long
arrList = frmRecordActuals.lstDirectTasks.list 'extract the list box elements in an array
ReDim arrFin(0 To UBound(arrList) + 1, 0 To UBound(arrList, 2)) 'redim the final array
For i = 0 To UBound(arrList) 'load the existing elements in the final array
For j = 0 To UBound(arrList, 2)
arrFin(k, j) = arrList(i, j)
Next j
k = k + 1
Next i
'add the new elements in the final array:
arrFin(k, 0) = lstWorkItems.list(lstWorkItems.ListIndex, 0)
arrFin(k, 1) = txtPcId.value
arrFin(k, 2) = txtDirectActivityName.value
arrFin(k, 3) = lstWorkItems.list(lstWorkItems.ListIndex, 1)
arrFin(k, 4) = lstWorkItems.list(lstWorkItems.ListIndex, 2)
arrFin(k, 5) = lstWorkItems.list(lstWorkItems.ListIndex, 3)
arrFin(k, 6) = lstWorkItems.list(lstWorkItems.ListIndex, 6)
arrFin(k, 7) = lstWorkItems.list(lstWorkItems.ListIndex, 4)
arrFin(k, 8) = lstWorkItems.list(lstWorkItems.ListIndex, 5)
arrFin(k, 9) = lstProcessStage.list(lstProcessStage.ListIndex, 1)
arrFin(k, 10) = lstProcessStage.list(lstProcessStage.ListIndex, 0)
arrFin(k, 11) = cboGrade.list(cboGrade.ListIndex, 1)
arrFin(k, 12) = cboGrade.list(cboGrade.ListIndex, 0)
arrFin(k, 13) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 1)
arrFin(k, 14) = cboWiderInitiative.list(cboWiderInitiative.ListIndex, 0)
arrFin(k, 15) = cboHours.value
arrFin(k, 16) = cboMinutes.value
arrFin(k, 17) = lblHasCasesID.Caption
If lblHasCasesID.Caption = 1 Then
arrFin(k, 18) = txtSelected.value
Else
arrFin(k, 18) = "N/A"
End If
If lblHasCasesID.Caption = 1 Then
arrFin(k, 19) = txtDeselected.value
Else
arrFin(k, 19) = "N/A"
End If
'load the listbox with the cumulated array:
frmRecordActuals.lstDirectTasks.list = arrFin
End If
End Sub