1


2 つの列の違い、つまりセルが 1 つの列に存在し、2 番目の列には存在しない場合に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アイコン）です。

4

2 に答える 2

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

より効率的な方法が他にもあることに注意してください。

于 2012-10-18T17:54:42.680 に答える
0

ネストされたループが現在機能している方法は次のとおりです。r1.cells の各 cc に対して、すべてのセルが cc(1) と等しいかどうかを確認し、そうでない場合はリストに追加してから、次の cc に進みます。そのため、1400 ではなく 1400x1400 の反復を行うことになります。

あなたが求めているのは、次のようなものです。

    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

ループの長さを、レコードが最も多い列の長さに設定したことに注意してください

于 2012-10-18T16:16:01.847 に答える