仅当 h 列中的单元格为红色时，如何让列表框填充范围内的所有行

Question

我正在尝试将范围 ("A3:H150") 中的信息填充到用户表单中的列表框，前提是 H 列中的单元格为红色，即 .Interior.ColorIndex = 3.无论列 H 中的单元格是否为红色，我的代码仍然会用所有数据填充列表框。

Dim lbtarget As MSForms.ListBox
Dim rngSource As Range
Set rngSource = Sheet1.Range("A3:H40")
Dim RNG As Range
Set RNG = Sheet1.Range("H3:H40")
Dim Cell As Range

Set lbtarget = Me.ListBox1
With lbtarget
    .ColumnCount = 8
    .ColumnWidths = "100;100;100;100;100;100;60;60"
    For Each Cell In RNG
        If Cell.Interior.ColorIndex = 3 Then
            .List = rngSource.Cells.Value
        End If
    Next
End With

Answer 1

   For Each Cell In RNG
        If Cell.Interior.ColorIndex = 3 Then
        .AddItem Sheet1.Range(Sheet1.Cells(Cell.Row,1),Sheet1.Cells(Cell.Row,8))
        End If
        Next
    End With

应该这样做：

Private Sub fillListBox()
    Dim myform As UserForm1
    Set myform = New UserForm1

    Dim loopRange As Range
    With Sheet1
        Set loopRange = .Range(.Cells(1, 8), .Cells(10, 8))
    End With
    With myform.ListBox1
        Dim Cell As Range
        Dim indexCounter As Long
        indexCounter = -1
        For Each Cell In loopRange
            If Cell.Interior.ColorIndex= 3 Then
                indexCounter = indexCounter + 1
                .AddItem Sheet1.Cells(Cell.Row, 1).Value
                Dim colCounter As Long
                For colCounter = 2 To 8
                    .List(indexCounter, colCounter - 1) = Sheet1.Cells(Cell.Row, colCounter).Value
                Next
                '
            End If
            Next
    End With
End Sub

Answer 2

将重组后的数组分配给.List 属性

程序doFillListBox

• 通过 Application.Index() 函数以及两个帮助函数和
重构整个数据集
• 通过 单个代码行 中的 .List 属性 将重组后的数组分配给指定的列表框，也称为 Array 方法;请参阅 [1] 部分）（而不是逐一添加列表框项目，也称为 AddItem 方法）。
• 布局在 [2] 部分完成：

Sub doFillListBox(lbTarget As MSForms.ListBox, rng As Range)
    With lbTarget
    ' =============================
    ' [1] restructure listbox items
    ' -----------------------------
      .List = Application.Index(rng.Value, getRowNums(rng), getColNums(rng))

    ' =============================
    ' [2] layout listbox
    ' -----------------------------
      .ColumnCount = rng.Columns.Count
      .ColumnWidths = "100;100;100;100;100;100;60;60"
    End With
End Sub

相关link：

上述过程调用的辅助函数

Function getRowNums(rng As Range, _
         Optional ByVal ColNo As Long = 8, _
         Optional ByVal backgroundColor = 3) As Variant()
'   Purpose: return "vertical" array with row numbers not marked in red background color (e.g.3)
'   Note:    column number default is the 8th column, default background color is red (3)
    Dim n&
    n = rng.Rows.Count
  ' [1] list uncolored row numbers within temporary array
    ReDim tmp(1 To n)                               ' provide for maximum length
    Dim i&, ii&                                     ' row numbers in column H, items counter
    For i = 1 To n                                  ' iterate through column H cells
        If rng.Cells(i, ColNo).Interior.ColorIndex <> backgroundColor Then  ' check criteria
            ii = ii + 1                             ' increment new items counter
            tmp(ii) = i                             ' enter "old" row number
        End If
    Next i
    ReDim Preserve tmp(1 To ii)                     ' reduce to actually needed length

  ' [2] return "vertical" list of needed row numbers
    getRowNums = Application.Transpose(tmp)         ' transpose to 2-dim array

End Function

Function getColNums(rng As Range) As Variant()
  ' Purpose: return all column numbers in a "flat" array, e.g. via Array(1,2,3,4,5,6,7,8)
    getColNums = Application.Transpose(Evaluate("row(1:" & rng.Columns.Count & ")"))
End Function

调用示例[​​=52=]

假设您要使用命令按钮控件的单击事件通过引用数据范围填充给定 ListBox，例如通过 sheet 的 CodeName:

Private Sub CommandButton1_Click()
  ' Note: change control names and range reference following your needs
    doFillListBox Me.ListBox1, Sheet1.Range("A3:H150")   ' reference e.g. to CodeName Sheet1
End Sub

注意: (Name) 属性 是 VB 编辑器工具 sheet 的代号标识符 window 相对于作品sheet.

的用户可修改 "tab" Name