Question

我试图编写一个代码，允许我查看两个非常相似的列，并清除第二列中副本的单元格（如果它已存在于第一列中）。我有一个代码有点工作，但它删除了一些重复项并向上移动它们，但我希望它们保留在原始单元格中。我基本上希望它说＆＃34;如果单元格存在于column1和column 2中，则清除第2列中的单元格＆＃34;。我不确定这是否可行。这是我一直在使用的代码。任何帮助将不胜感激！

Sub CopyPasteHistorical()

CopyPasteHistorical Macro

Sheets("Sheet1").Select

Columns("I:I").Select
Selection.copy
Sheets("Sheet2").Select
Columns("D:D").Select
ActiveSheet.Paste
'remove duplicates
Columns("C:D").Select
Dim duplicates As Range
Set duplicates = Selection
Selection.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

End Sub

Answer 1

要做Scott正在谈论的事情，您可以尝试以下方法：

Sub Test()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Sheets("Sheet1")

    'get the last row of the 1st column, "A" in this case
    Dim lastRow As Integer
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row


    Dim i As Integer
    'loop through all the rows of column A
    For i = 1 To lastRow
        'get value of cell, find and replace with "" in column "B"
        Dim curVal
        curVal = ws.Range("A" & i).Value
        ws.Columns("B").Replace _
            What:=curVal, Replacement:="", _
            SearchOrder:=xlByColumns, MatchCase:=True
    Next i


End Sub

这将使用空白替换B列中的重复项，而不是删除/向上移动。

Answer 2

我采取相反的方式，例如关注（评论）代码：

Option Explicit

Sub CopyPasteHistorical()
    Dim sht1Rng As Range, cell As Range

    With Worksheets("Sheet1") '<-- reference Sheet1
        Set sht1Rng = .Range("I1", .Cells(.Rows.Count, "I").End(xlUp)).SpecialCells(xlCellTypeConstants) '<-- set range with its column "I" cells containing constant (i.e. not formulas) values
    End With

    With Worksheets("Sheet2") '<-- reference Sheet2
        For Each cell In sht1Rng '<-- loop through Sheet1 range
            If cell.Value <> .Cells(cell.Row, "C") Then .Cells(cell.Row, "D") = cell.Value '<-- if sheet1 current cell content is different from Sheet2 column "C" cell content in the same row then write it in Sheet 2 column "D" corresponding row
        Next cell
    End With
End Sub

这样你：

只打扰Sheet1栏＆＃34;我＆＃34;相关细胞（即非空白细胞）
不要进行不必要的复制和粘贴
仅在Sheet2中编写所需值

如何查看两列并删除第二列中的重复项

2 个答案: