如何通过两列之间的差异填充ListBox

时间:2012-10-18 15:50:44

标签: excel vba

我想通过两列之间的差异来填充ListBox 即,如果一个单元存在于一列中,并且在第二列中不存在

Dim r1 As Range, r2 As Range
Set r1 = Range(Sheets(1).Range("B2"), Sheets(1).Range("B" & Rows.Count).End(xlUp))
Set r2 = Range(Sheets(2).Range("B2"), Sheets(2).Range("B" & Rows.Count).End(xlUp))
For Each cc In r1.Cells
For Each cell In r2.Cells
If Not cc.Value = cell.Value Then Form1.ListBox1.AddItem cell.Value
Next cell
Next cc
Form1.Show

我得到的是无尽的过程(sandClock图标)。

2 个答案:

答案 0 :(得分:1)

替代解决方案,我认为可以实现OP要求

Private Sub UserForm_Initialize()
    Dim r1 As Range, r2 As Range
    Dim i As Long, j As Long
    Dim d1, d2
    Dim mtch As Boolean

    Set r1 = Range(Sheets(1).Range("B2"), Sheets(1).Range("B" & Rows.Count).End(xlUp))
    Set r2 = Range(Sheets(2).Range("B2"), Sheets(2).Range("B" & Rows.Count).End(xlUp))
    d1 = r1
    d2 = r2

    For i = 1 To UBound(d1)
        mtch = False
        For j = 1 To UBound(d2)
            If d1(i, 1) = d2(j, 1) Then
                mtch = True
                Exit For
            End If
        Next j
        If Not mtch Then
            Me.ListBox1.AddItem d1(i, 1)
        End If
    Next i
    Me.Show
End Sub

注意,还有其他方法可能更有效,但对于1400行,这会立即填充列表

答案 1 :(得分:0)

嵌套循环现在正在运行的方式是:对于r1.cells中的每个cc,它检查每个单元格是否等于cc(1),如果没有将它添加到列表中,则继续执行下一个cc。所以你最终会做1400x1400次迭代而不是1400次。

我认为你所追求的更像是这样:

    Dim r1 As long, r2 As long
    r1 = Sheets(1).Range("B" & Rows.Count).End(xlUp).row
    r2 = Sheets(2).Range("B" & Rows.Count).End(xlUp).row
    'set looping integer = to the longest column
    if r1>r2 then 
        r3 = r1
    elseif r2>r1 then 
        r3 = r2
    else: r3 = r1 'if equal set to sheet1 column length
    end if
    for i = 1 to r3 'loop through each row at same time for both sheets
        If sheets(1).range("B" & i).Value <> sheets(2).range("B" & i).Value Then Form1.ListBox1.AddItem sheets(2).range("B" & i).Value
    Next i
    Form1.Show

请注意,我将循环长度设置为具有最多记录的列的长度