如何在粘貼數據時查看上一列

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