粘贴数据时如何查看上一列

Question

我有一个代码可以让我从参考表中查找重复值，如果它们不重复，它会将不同的值粘贴到“历史注释”表中。这是为了跟踪我对某个主题所做的 cmets。 cmets 偶尔会更改，我想保留一份历史评论表以跟踪我过去所做的更改。我有一个代码将在第一张表中查找并搜索重复项并将唯一值粘贴到此背页中，但我想知道是否有一种方法可以将代码粘贴到下一列中，如果当前单元格已经有其中的一个值。我只是想确保我的代码不会覆盖过去的历史 cmets。这是代码：

Option Explicit

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

With Worksheets("AAG") '<-- 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

我希望这是有道理的，任何帮助将不胜感激！谢谢！

Answer 1

这是您的子例程的一个版本，如果当前值与已存储的最后一个值不同，它将在下一列中存储当前值：

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

    With Worksheets("AAG") '<-- 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
            'determine last used column in row we are processing
            lastCol = .Cells(cell.Row, .Columns.Count).End(xlToLeft).Column
            If lastCol < 3 Then
                'if the last used column on the row is before column C
                'we need to store this value in column C
                .Cells(cell.Row, 3).Value = cell.Value
            ElseIf cell.Value <> .Cells(cell.Row, lastCol).Value Then
                'if the last value on the row is different to the current value
                'we need to store this value in the next column to the right
                .Cells(cell.Row, lastCol + 1).Value = cell.Value
            End If
        Next cell
    End With
End Sub

---

这是您的子例程的一个版本，它只会存储以前从未使用过的当前值：

Sub CopyPasteHistorical()
    Dim sht1Rng As Range, cell As Range
    Dim Col As Long
    Dim lastCol As Long
    Dim blnMatched As Boolean

    With Worksheets("AAG") '<-- 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
            'determine last used column in row we are processing
            lastCol = .Cells(cell.Row, .Columns.Count).End(xlToLeft).Column
            If lastCol < 3 Then
                'if the last used column on the row is before column C
                'we need to store this value in column C
                .Cells(cell.Row, 3).Value = cell.Value
            Else
                'see if this value has already been stored
                blnMatched = False
                For Col = 3 To lastCol
                    If cell.Value = .Cells(cell.Row, Col).Value Then
                        blnMatched = True
                        Exit For
                    End If
                Next
                'if the current value doesn't match any previous values
                'we need to store this value in the next column to the right
                If Not blnMatched Then
                    .Cells(cell.Row, lastCol + 1).Value = cell.Value
                End If
            End If
        Next cell
    End With
End Sub

Answer 2

不太确定了解您的真正目标，但您可能想尝试一下

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

    With Worksheets("AAG") '<-- reference worksheet "AAG"
        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 Worksheet "Sheet2"
        For Each cell In sht1Rng '<-- loop through Sheet1 range
            If cell.Value <> .Cells(cell.Row, "C") Then .Cells(cell.Row, .Columns.Count).End(xlToLeft).Offset(, IIf(.Cells(cell.Row, "D") = "", 3, 1)) = 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 corresponding row first free cell from column "D" rightwards
        Next cell
    End With
End Sub