Question

我正在尝试比较同一工作表中B列与AB列的数据。如果存在匹配项，那么我想从AB列中删除该匹配项。匹配完成后，我想将剩余数据复制到Z列中。

到目前为止，我研究的是this，但我没有与不同工作簿上的同一列进行比较。

我已经附上了一些截图，如下所示：

我当前的代码在这里`

Sub CompareNRemove()

For i = 1 To last_cell_B
        For j = 1 To last_cell_AB
        If Worksheets("Sheet1").Range("B" & i).Value = Worksheets("Sheet1").Range("AB" & j).Value Then
           Worksheets("Sheet2").Range("C" & i).Value = Worksheets("sheet2").Range("b" & j).Value
        End If
        Next j
    Next i

 Next r

 'Sheets("Sheet1").Range("AB18:AC999").ClearContents
 'Call MatchNSortW

End Sub


For r = 18 To Cells(Rows.Count, "E").End(xlUp).row     ' From row 1 to the last row with data
    On Error Resume Next

    myCountif = ThisWorkbook.Sheets("Sheet1").Cells(r, "E")
    myLookup = ThisWorkbook.Sheets("Sheet1").Cells(r, "E")

    MyAnswer = Application.WorksheetFunction.Application.Countif(Range("AB18:AB999"), Cells(r, "E"))


    If MyAnswer = 1 Then
    Match = Application.WorksheetFunction.Application.VLookup(myLookup, ThisWorkbook.Sheets("Sheet1").Range("AB18:AB999"), 1, 0)
    Cells(r, "B").Value = Match


    'Check = Application.WorksheetFunction.Application.VLookup(Match, Range("AB18:AB999"), 0)
    'Cells(r, "D").Value = Check

    'Check it off the list
    'Check = Application.WorksheetFunction.Application.Match(Cells(r, "B"), Range("AB18:AB999"), 0)


    'Checkup = Application.WorksheetFunction.Application.Match(MyAnswer, ThisWorkbook.Sheets("Sheet1").Range("AB18:AB999"), 0)



    ElseIf MyAnswer = 0 Then
    Cells(r, "B").Value = ""

    End If



 Next r

'Sheets("Sheet1").Range("AB18:AC999").ClearContents
'Call MatchNSortW

End Sub`

Answer 1

这将获取AB列中不存在于B列中的值，并将它们放入Z列中。如果您还想从AB列中删除重复的值，则只需清除AB列并在其中传输相同的值。 / p>

Sub CompareNRemove()

    dim i as long, arrB as variant, arrAB as variant, z as object

    set z = createobject("scripting.dictionary")

    with worksheets("sheet101")

        arrB = .range(.cells(2, "B"), .cells(.rows.count, "B").end(xlup)).value
        arrAB = .range(.cells(2, "AB"), .cells(.rows.count, "AB").end(xlup)).value

        for i=lbound(arrab, 1) to ubound(arrab, 1)
            if arrab(i, 1) <> vbnullstring then
                if iserror(application.match(arrab(i, 1), arrb, 0)) then
                    z.item(arrab(i, 1)) = vbnullstring
                end if
            end if
        next i

        .cells(2, "Z").resize(z.count, 1) = application.transpose(z.keys)

    end with

end sub

比较同一工作表VBA中的两列

1 个答案: