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

Question

我正在尝试使用以下代码填充 VBA 用户表单列表框。如果 i select 范围从 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,40,40,2,60,60,60,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

下面的代码用于更新用户表单下的多个 selected 行。它只更新第 selected 行而不是所有 selected 行。

    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), , xlValues, xlWhole)
        If Not vrech Is Nothing Then
          Select Case cmbaction.Value
            Case "RP"
              t = Chr(Asc(Mid(.List(i, 4), 2, 1)) + 1)
              'Me.lstDatabase.Row (0), Column(4) = "ABA"
              t1 = Mid(.List(i, 4), 1, 1) & t & Mid(.List(i, 4), 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

Answer 1

填充列表框

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

a) 通过列表框的 .RowSource 属性（显示 headers）或
b) 通过列表框的 .List 属性（不允许 headers）

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

此外，我建议将您的代码移动到表单自己的代码模块中 - UserForm_Initialize 处理程序将是一个很好的地方。 C.f。

版本 a)

请注意，您必须在“'”中包含一个以空格分隔的 sheet 名称 (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)

"It works if i select range from A to F column. however if i change A to L, it give me an error."

通过 .AddItem 方法添加数据有一个未记录的限制 仅 10 列
（这些作为 .List 属性的空数组项自动提供）。因此，不可能引用 10 或更多的 (zero-based) 列索引，因为它不存在。

您可以通过将整个数据字段数组分配给列表框 .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 如果没有明确声明 (Dim r as Range, c As Range).

，则 r 假定 Variant

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

populate VBA list box from row source and update multiple rows

excel

vba

listbox

userform