列表框显示唯一编号，如果特定列的值为零（0）vba excel，则不显示列出答案

【问题标题】：Listbox show unique number and does not show listed if specific column has zero(0) value vba excel列表框显示唯一编号，如果特定列的值为零（0）vba excel，则不显示列出
【发布时间】：2021-07-14 06:33:07
【问题描述】：

'我的代码在这里 Userform1 为 listbox1 初始化

Private Sub UserForm_Initialize()

  Dim sh As Worksheet, arr As Variant, arrFin As Variant, countD As Long
  Dim LastRow As Long, i As Long, j As Long, k As Long, boolDupl As Boolean
  Set sh = Worksheets("Sheet1") 
  LastRow = sh.range("A" & Rows.Count).End(xlUp).Row
  ReDim arrFin(1 To 2, 1 To LastRow)  
  arr = sh.range("A2:B" & LastRow).value 
  k = 1 
  For i = 1 To UBound(arr, 1)
    boolDupl = False  
    For j = 1 To k    'iterate between the arrFin elements in order to check for duplicates
        If arr(i, 1) & arr(i, 2) = arrFin(1, j) & arrFin(2, j) Then
              boolDupl = True: Exit For 
        End If
    Next j
    If Not boolDupl Then 
        arrFin(1, k) = arr(i, 1): arrFin(2, k) = arr(i, 2)
        k = k + 1       
    End If
  Next
  ReDim Preserve arrFin(1 To 2, 1 To k - 1)    
  With Me.ListBox1
        .clear
        .ColumnCount = False
        .ColumnCount = 2 
        .List = WorksheetFunction.Transpose(arrFin) 
        .ColumnWidths = "50;500"
        .TopIndex = 0
    End With
End Sub

首先，我希望 listbox1 按 sheet1 列 (A) 然后列 (C) 显示唯一列表，对于代码：1101，所有值都为零 (0)，它不会被 listbox1 列出。所以 Listbox1 只显示唯一列表代码：1102 和 1103。

请按照我的附件图片了解详情。请帮帮我

Populate Listbox

【问题讨论】：

标签： excel vba

【解决方案1】：

您当前的代码正在获取基于 A 列和 B 列的唯一值。

如果您只想要基于 A 列的唯一值并且想要排除 C 列为 0 的值，请尝试以下代码。

Private Sub UserForm_Initialize()
Dim sh As Worksheet, arr As Variant, arrFin As Variant, countD As Long
Dim LastRow As Long, i As Long, j As Long, k As Long, boolDupl As Boolean

    Set sh = Worksheets("Sheet1")

    LastRow = sh.Range("A" & Rows.Count).End(xlUp).Row

    ReDim arrFin(1 To 1, 1 To LastRow)

    arr = sh.Range("A2:C" & LastRow).Value

    k = 1

    For i = 1 To UBound(arr, 1)
        If arr(i, 3) <> 0 Then
            boolDupl = False
            For j = 1 To k    'iterate between the arrFin elements in order to check for duplicates
                If arr(i, 1) = arrFin(1, j) Then
                    boolDupl = True: Exit For
                End If
            Next j
            If Not boolDupl Then
                arrFin(1, k) = arr(i, 1)
                k = k + 1
            End If
        End If
    Next i

    ReDim Preserve arrFin(1 To 1, 1 To k - 1)
    
    With Me.ListBox1
        .ColumnCount = False
        .ColumnCount = 1
        .List = WorksheetFunction.Transpose(arrFin)
        .ColumnWidths = "50"
        .TopIndex = 0
    End With
    
End Sub

注意，还有其他不涉及多个循环的方法可以做到这一点，例如字典，计算代码中的公式。

评估示例

这是一个通过评估公式来执行此操作的示例，它专门用于 Office365。

Private Sub UserForm_Initialize()
Dim sh As Worksheet, arrFin As Variant
Dim LastRow As Long

    Set sh = Worksheets("Sheet1")

    LastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
    arrFin = Evaluate("SORT(UNIQUE(FILTER(A2:A" & LastRow & ", C2:C" & LastRow & "<>0)))")
    
    With Me.ListBox1
        .ColumnCount = False
        .ColumnCount = 1
        .List = arrFin
        .ColumnWidths = "50"
        .TopIndex = 0
    End With
    
End Sub

【讨论】：