VBA Excel超过10列ListBox，从其他列表框中填充值答案

【问题标题】：VBA Excel more than 10 column ListBox, Populate values from other listboxVBA Excel超过10列ListBox，从其他列表框中填充值
【发布时间】：2021-06-07 07:29:31
【问题描述】：

目前我正在并排填充 2 个列表框，以提供有关用户表单的信息，然后将其填充到 SQL 数据库表中。

我需要将 2 个列表框变成一个多列列表框，但有 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

【问题讨论】：

对我来说不太清楚...您需要直接填充列表（而不是现有的两个），还是从现有的两个填充？
如果您想要超过 10 列，则不能使用 AddItem。您需要使用范围或将数组分配给控件的List（或Column）属性。
编辑添加到原始问题。我对数组没有经验，非常感谢您的帮助。
还是不清楚...你喜欢先填充两个现有的列表框，然后取出它们的项目并填充另一个列表框（20列）吗？然后，为每个代码运行在所有三个列表框中添加另一行？
我问过你这方面的问题，你什么都没说，编辑了你的问题，二合一谈了......重要的想法是你不能使用AddItem超过10列。因此，您必须首先将数据加载到数组中，比如说arrData，然后简单地使用listBoxName.List = arrData。

标签： excel vba listbox multiple-columns populate

【解决方案1】：

请测试下一个代码。当然，没有经过测试，但它应该可以工作：

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

【讨论】：

那太好了。正是我想要的。非常感谢您的坚持和帮助。抱歉没有正确解释问题。
@dori2o：很高兴我（最后）能帮上忙！我现在要走了……