从行源填充VBA列表框并更新多行

如何解决从行源填充VBA列表框并更新多行

我正在尝试使用以下代码填充VBA用户窗体列表框。如果我选择从A到F列的范围，它将起作用。但是，如果我将A更改为L，则会出现错误。

您能帮我更正以下代码吗？

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("part bump")

    Dim Last_Row As Long
    Dim r,c As Range

    Last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

    With UserForm3
       
        .lstDatabase.ColumnCount = 11
        .lstDatabase.ColumnHeads = True
        .lstDatabase.ColumnWidths = "20,40,2,60,300,60"
        
        Set r = sh.Range("A4:F" & Last_Row)
     
        i = 0
        For Each d In r.Rows
            j = 0
            For Each c In d.Cells
                UserForm3.lstDatabase.AddItem
     
                UserForm3.lstDatabase.List(i,j) = c.Value
                j = j + 1
     
            Next c
            i = i + 1
        Next d
     
        If Last_Row = 1 Then
            UserForm3.lstDatabase.RowSource = "part bump!A4:F4"
        
        End If
        
    End With

以下代码用于更新用户窗体下的多个选定行。它只会更新第一个选定行，而不是所有选定行。

    Private Sub cmdaction_Click()
    Dim t,t1 As String
  Dim vrech As Range,lColumn As Range
  Dim sh As Worksheet
  Dim i As Long
  Dim selItem As String
  
  Set sh = ThisWorkbook.Sheets("part bump")
  Set lColumn = sh.Range("H1:AZA1").Find(Val(txtchangenumber.Value),xlValues,xlWhole)
  If lColumn Is Nothing Then
    MsgBox "Column not found"
    Exit Sub
  End If
  
  With UserForm3.lstDatabase
    For i = 0 To UserForm3.lstDatabase.ListCount - 1
    
      If UserForm3.lstDatabase.Selected(i) = True Then
        Set vrech = sh.Range("E3:E250").Find(.Column(4,i),xlWhole)
        If Not vrech Is Nothing Then
          Select Case cmbaction.Value
            Case "RP"
              t = Chr(Asc(Mid(.List(i,4),1)) + 1)
              'Me.lstDatabase.Row (0),Column(4) = "ABA"
              t1 = Mid(.List(i,1,1) & t & Mid(.List(i,3,1)
              Intersect(vrech.EntireRow,lColumn.EntireColumn) = t1
          Case "RV"
            Intersect(vrech.EntireRow,lColumn.EntireColumn) = .List(i,4)
          Case "DP"
            Intersect(vrech.EntireRow,lColumn.EntireColumn) = "Deleted"
            vrech.EntireRow.Font.Strikethrough = True
          End Select
        End If
      End If
      
    Next i
  End With
End Sub

解决方法

填充列表框

我不清楚您是否要分配范围数据

.RowSource

a）或
b）（通过列表框的.List属性（不允许使用标题）

我将演示两种修改原始代码的方法。

此外，我建议将您的代码移到表单自己的代码模块中-UserForm_Initialize处理程序将是一个不错的选择。 C.f.

版本a）

请注意，您必须在“'”中添加一个以空格分隔的工作表名称（part bump），例如通过

.RowSource = "'part bump'!A4:L17"

或

.RowSource = "'" & sh.Name & "'!" & rng.Address

Private Sub UserForm_Initialize()
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("part bump")
    
    Const HeaderRow As Long = 3
    Dim LastRow     As Long
    LastRow = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
    If LastRow = HeaderRow Then LastRow = HeaderRow + 1 ' provide for empty data
    
    Dim rng As Range
    Set rng = sh.Range("A" & HeaderRow + 1 & ":L" & LastRow)
    Debug.Print rng.Address
    
    With lstDatabase
        .ColumnCount = 11
        .ColumnWidths = "20;40;40;40;2;60;60;60;60;300;60"
        
        'a) Row Source plus headers
        .ColumnHeads = True
        .RowSource = "'" & sh.Name & "'!" & rng.Address   ' << don't forget "'" around sheet name!

    End With
    
End Sub

版本b）

“如果我在A到F列之间选择范围，它会起作用。但是，如果我将A更改为L，则会给我一个错误。”

通过.AddItem方法添加数据的未记录限制为仅 10列
（这些属性作为.List属性的空数组项自动提供）。因此，不可能引用10或更大的（从零开始的）列索引，因为它不存在。

通过将整个数据字段数组分配给列表框的.List属性，可以缩短代码并克服此限制。 c.f。：Populate listbox with multiple columns

Private Sub UserForm_Initialize()
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("part bump")
    
    Const HeaderRow As Long = 3
    Dim LastRow     As Long
    LastRow = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
    If LastRow = HeaderRow Then LastRow = HeaderRow + 1 ' provide for empty data
    
    Dim rng As Range
    Set rng = sh.Range("A" & HeaderRow + 1 & ":L" & LastRow)
    Debug.Print rng.Address
    
    With lstDatabase
        .ColumnCount = 11
        .ColumnWidths = "20;40;40;40;2;60;60;60;60;300;60"
        
        'b) alternatively via array assignment (without headers!)
        '   allows to overcome 10 column limitation of .AddItem
        .ColumnHeads = False

        .List = rng.Value   ' << assign data field array as a whole to .List
    End With
    
End Sub

其他提示

您在OP（Dim r,c As Range）中的声明打算为两个变量声明Range数据类型，但这会失败，因为VBA如果未明确声明（Variant，则假定r的{{1}}。

从行源填充VBA列表框并更新多行

如何解决从行源填充VBA列表框并更新多行

解决方法

相关推荐