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

我想通过两列之间的differencies填充列表框
即如果一个单元存在于一列中，而第二个单元不存在

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图标）。

Answer 1

替代解决scheme，我认为达到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行来说，这几乎立即填充列表

Answer 2

现在你的嵌套循环正在工作的方式是：对于r1.cell中的每个cc，它检查每个单元格是否等于cc（1），如果没有将其添加到列表中，则继续下一个cc。 所以你最终做1400×1400迭代而不是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 

请注意，我将循环长度设置为具有最多logging的列的长度