Как сделать трек-изменения для конкретного столбца / диапазона - PullRequest
0 голосов
/ 13 февраля 2019

У меня есть таблица с количеством столбцов и строк, и я хотел бы отслеживать изменения, внесенные в конкретный столбец.Я нашел код (см. Внизу сообщения) онлайн, и он отлично работает.Тем не менее, он отслеживает «все изменения».Есть ли способ сделать это конкретным диапазоном.Например, я хочу отслеживать изменения, сделанные в столбце, только с красными цифрами.Пожалуйста, см. Пример:

enter image description here

Код, который я нашел в Интернете, следующий:

Option Explicit

Dim vOldVal 'Must be at top of module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim bBold As Boolean
    If Target.Cells.Count > 1 Then Exit Sub
    If ActiveSheet.Name = "Pricing" Then Exit Sub
    'On Error Resume Next
    With Application
         .ScreenUpdating = False
         .EnableEvents = False
    End With
    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
        With Sheets("Data")
            '.Unprotect Password:="Secret"
                If .Range("A96") = vbNullString Then
                    .Range("A96:H96") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change")
                End If
            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & Target.Address
                  .Offset(0, 1) = vOldVal
            With .Offset(0, 2)
              If bBold = True Then
                .ClearComments
                .AddComment.Text Text:= _
                     "OzGrid.com:" & Chr(10) & "" & Chr(10) & _
                        "Bold values are the results of formulas"
              End If
                .Value = Target
                .Font.Bold = bBold

            End With
                .Offset(0, 3) = Time
                .Offset(0, 4) = Date
                .Offset(0, 5) = Application.UserName
            End With
            .Cells.Columns.AutoFit
            '.Protect Password:="Secret"
        End With
    vOldVal = vbNullString
    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
    On Error GoTo 0
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
        vOldVal = Target
End Sub


Private Sub test()
    Application.EnableEvents = True
End Sub

Пожалуйста, имейте в виду, что яЯ очень новичок в кодировании VBA.

1 Ответ

0 голосов
/ 13 февраля 2019

Вы можете сделать это, добавив одну строку к существующему коду:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim bBold As Boolean
    If Target.Cells.Count > 1 Then Exit Sub
    If ActiveSheet.Name = "Pricing" Then Exit Sub
    If Target.Column <> 4 Then Exit Sub

Это просто проверит, является ли это 4-й столбец вашего листа, который был изменен, и проигнорирует изменения в другом месте..

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...