Блог

У меня есть код, который позволяет мне искать повторяющиеся значения из справочного листа, и, если они не являются дубликатами, он вставит это другое значение в лист «исторических комментариев». Это делается для отслеживания комментариев, которые я сделал по теме. Комментарии иногда меняются, и я хочу сохранить таблицу исторических комментариев, чтобы отслеживать прошлые изменения, которые я внес. У меня есть код, который будет просматривать первый лист, искать дубликаты и вставлять уникальные значения в этот задний лист, но мне было интересно, есть ли способ вставить код в следующий столбец, если в текущей ячейке уже есть значение. в нем. Я просто хочу убедиться, что мой код не записывает прошлые исторические комментарии. Вот код:

 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
  

Я надеюсь, что это имеет смысл, и любая помощь будет оценена по достоинству! Спасибо!

Вот версия вашей подпрограммы, которая сохранит текущее значение в следующем столбце, если оно отличается от последнего сохраненного значения:

 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
  

Не уверен, что понимаю вашу реальную цель, но вы можете попробовать это

 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