Сравните два столбца в одном листе VBA - PullRequest
0 голосов
/ 03 марта 2019

Я пытаюсь сравнить данные из столбца B с столбцом AB на одном листе.Если есть совпадение, то я хочу удалить совпадение из столбца AB.После завершения сопоставления я хотел бы скопировать оставшиеся данные в столбец Z.

До сих пор я исследовал this , но я не сравниваю этот же столбец наразличные рабочие книги.

Я приложил несколько снимков экрана, показанных ниже:

ColumnA ColumnAB

Мой текущий код здесь `

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`

1 Ответ

0 голосов
/ 03 марта 2019

Это возьмет значения в столбце AB, которые не существуют в столбце B, и поместит их в столбец Z. Если вы также хотите удалить дублированные значения из столбца AB, просто очистите столбец AB и перенесите туда те же значения.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...