Question

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

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

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

2 个答案: