Отслеживание изменений на листе, копирование активных ячеек с изменением заголовка столбца и NewColumnValue

REF: отслеживать изменения на листе, копировать ячейку, которая не является активной ячейкой в ​​активной строке ячеек, и записывать значение

Я обновил свой рабочий лист и надеюсь получить представление о том, как получить значения в ячейках при изменении события...

  • NewColumn__Value — в настоящее время ни один из них не вытягивает правильное значение. активная ячейка влияет на результаты и требует, чтобы изменения до и после события сравнивались позже. я знаю, что в настоящее время он выводит то же самое, что и соответствующее OldVColumn_Value, но оставлен, чтобы помочь с передачей запроса.
  • ColumnHeader — в настоящее время не извлекает никакого значения. заголовок находится во 2-й строке 'target.value

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

Option Explicit
Public OldValue, OldColumnJValue, ColumnHeaderX, ColumnJValue, ColumnHeader, OldColumnJJValue, 
OldColumnJKValue, OldColumnJLValue, OldColumnJMValue, NewColumnJJValue, NewColumnJKValue, 
NewColumnJLValue, NewColumnJMValue, OldColumnMPValue, OldColumnMQValue, OldColumnMRValue, 
OldColumnMSValue, NewColumnMPValue, NewColumnMQValue, NewColumnMRValue, NewColumnMSValue, 
OldColumnPVValue, OldColumnPWValue, OldColumnPXValue, OldColumnPYValue, NewColumnPVValue, 
NewColumnPWValue, NewColumnPXValue, NewColumnPYValue

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
        With Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp)
            .Offset(1, 0) = ActiveSheet.Name
            .Offset(1, 1) = Target.Address(0, 0)
            .Offset(1, 2) = Environ("username")
            .Offset(1, 3) = Now
                'add empl name vlookup formula to this column?
            .Offset(1, 5) = ColumnJValue
            **.Offset(1, 6) = ColumnHeader**
            .Offset(1, 7) = OldValue
            .Offset(1, 8) = Target
                '2020 pre-change value below
            .Offset(1, 9) = OldColumnJJValue
            .Offset(1, 10) = OldColumnJKValue
            .Offset(1, 11) = OldColumnJLValue
            .Offset(1, 12) = OldColumnJMValue
                '2020 post-change value below
            **.Offset(1, 13) = NewColumnJJValue
            .Offset(1, 14) = NewColumnJKValue
            .Offset(1, 15) = NewColumnJLValue
            .Offset(1, 16) = NewColumnJMValue**
                '2021 pre-change value below
            .Offset(1, 18) = OldColumnMPValue
            .Offset(1, 19) = OldColumnMQValue
            .Offset(1, 20) = OldColumnMRValue
            .Offset(1, 21) = OldColumnMSValue
                '2021 post-change value below
            **.Offset(1, 22) = NewColumnMPValue
            .Offset(1, 23) = NewColumnMQValue
            .Offset(1, 24) = NewColumnMRValue
            .Offset(1, 25) = NewColumnMSValue**
                '2022 pre-change value below
            .Offset(1, 27) = OldColumnPVValue
            .Offset(1, 28) = OldColumnPWValue
            .Offset(1, 29) = OldColumnPXValue
            .Offset(1, 30) = OldColumnPYValue
                '2022 post-change value below
            **.Offset(1, 31) = NewColumnPVValue
            .Offset(1, 32) = NewColumnPWValue
            .Offset(1, 33) = NewColumnPXValue
            .Offset(1, 34) = NewColumnPYValue**
        End With
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Cells.Count = 1 Then
        OldValue = Target
           'Program name changed
        ColumnJValue = Range("A1")(Target.Row, 10)
           'Column header of changed cell
        **ColumnHeader = Range("A1")(Target.Row, (2, 0)**
           '2020 pre-change value below
        OldColumnJJValue = Range("A1")(Target.Row, 270)
        OldColumnJKValue = Range("A1")(Target.Row, 271)
        OldColumnJLValue = Range("A1")(Target.Row, 272)
        OldColumnJMValue = Range("A1")(Target.Row, 273)
           '2020 post-change value below
        **NewColumnJJValue = Range("A1")(Target.Row, 270)
        NewColumnJKValue = Range("A1")(Target.Row, 271)
        NewColumnJLValue = Range("A1")(Target.Row, 272)
        NewColumnJMValue = Range("A1")(Target.Row, 273)**
           '2021 pre-change value below
        OldColumnMPValue = Range("A1")(Target.Row, 354)
        OldColumnMQValue = Range("A1")(Target.Row, 355)
        OldColumnMRValue = Range("A1")(Target.Row, 356)
        OldColumnMSValue = Range("A1")(Target.Row, 357)
           '2021 post-change value below
        **NewColumnMPValue = Range("A1")(Target.Row, 354)
        NewColumnMQValue = Range("A1")(Target.Row, 355)
        NewColumnMRValue = Range("A1")(Target.Row, 356)
        NewColumnMSValue = Range("A1")(Target.Row, 367)**
           '2022 pre-change value below
        OldColumnPVValue = Range("A1")(Target.Row, 438)
        OldColumnPWValue = Range("A1")(Target.Row, 439)
        OldColumnPXValue = Range("A1")(Target.Row, 440)
        OldColumnPYValue = Range("A1")(Target.Row, 441)
           '2022 post-change value below
        **NewColumnPVValue = Range("A1")(Target.Row, 438)
        NewColumnPWValue = Range("A1")(Target.Row, 439)
        NewColumnPXValue = Range("A1")(Target.Row, 440)
        NewColumnPYValue = Range("A1")(Target.Row, 441)**
        Exit Sub
    End If
    MsgBox "Multiple cell selections are not allowed on this sheet", vbCritical
    ActiveCell.Select
End Sub

Я не уверен, в чем вопрос, но я бы, вероятно, попытался использовать словарь вместо длинного списка переменных и, где это возможно, прокрутить его.

Christofer Weber 26.12.2020 01:14

В основном спрашивают 2 вещи. Во-первых, когда активная ячейка изменяется, скажем, R13, это влияет на значения других ячеек в этой строке. Я хочу скопировать эти значения и поместить в logdetails ws. Все хорошо с получением старых значений до изменения из Col JJ13: JM13, MP13: MS13 и PV13: PY13 (и т. д.), но также необходимо записать значения после изменения тех же ячеек. Изменение в R13 влияет на эти ячейки, и я хочу записать значения до/после изменения. Затем выведите на вкладке logdetails другие значения. Во-вторых, там, где есть активное изменение ячейки, запишите ColumnHeader, расположенный в строке 2.

GD-9 26.12.2020 01:51

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

Variatus 26.12.2020 03:55

Я верю, что следую за тобой. да, я пытался использовать эти значения при изменении следующей ячейки. я не могу получить значения, помещенные в правильную строку, где они должны быть для последующего анализа. его нужно сдвинуть вверх на 1 строку. я хочу поместить все данные в logdetails в одну и ту же строку, независимо от того, какое смещение строки я их изменяю.

GD-9 26.12.2020 06:16

я смог использовать старые значения в другом подходе, так что я в порядке. спасибо за все идеи.

GD-9 26.12.2020 07:17
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
0
5
120
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Я рад узнать из вашего комментария, что вы решили свою проблему. Отличная работа! Я действительно считал то, что вы взялись за эту задачу, весьма героическим и не хотел бы ни выбросить мою работу, ни лишить вас ее возможной пользы. Пожалуйста, обратите внимание.

Option Explicit

Private PrevVal(1)  As Variant      ' previously selected row data
                                    ' PrevVal(0) = row number, PrevVal(1) = row's data
Enum Nws                            ' data tab (ActiveSheet)
    ' 147
    NwsHeaderRow = 2                ' change to suit (data start immediately below this row)
    NwsClmJ = 10                    ' Debug.Print Columns("J").Column
    NwsClmJJ = 270
    NwsClmJK                        ' no assigned value means preceding + 1
    NwsClmJL
    NwsClmJM
    NwsClmMP = 354
    NwsClmMQ
    NwsClmMR
    NwsClmMS
    NwsClmPV = 438
    NwsClmPW
    NwsClmPX
    NwsClmPY
    NwsTop                      ' defining the last used column
End Enum

Private Sub Worksheet_Activate()
    ' 147
    SetPrevVal ActiveCell.Row
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 147
    SetPrevVal Target.Row
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 147
    
    Dim TriggerRange    As Range        ' range of relevant changes
    Dim MsgTxt()        As String       ' error message
    Dim Log(1 To 34)    As Variant      ' Log entry
    Dim Employee        As String       ' employee's name (retrieved by VLOOKUP)
    Dim i               As Long         ' index of Log()
    
    Set TriggerRange = Range(Cells(NwsHeaderRow + 1, 1), _
                             Cells(Rows.Count, "A").End(xlUp)) _
                             .Resize(, NwsTop - 1)
                             Debug.Print TriggerRange.Address
    With Target
        If Not Application.Intersect(Target, TriggerRange) Is Nothing Then
            If .Cells.CountLarge > 1 Then
                MsgTxt = Split("Please change only one cell at a time on this sheet." & _
                             "|Unsupported user action", "|")
            Else
                If IsEmpty(PrevVal) Then
                    MsgTxt = Split("?")
                ElseIf PrevVal(0) <> .Row Then
                    MsgTxt = Split("?")
                End If
                If Join(MsgTxt) = "?" Then
                    MsgTxt = Split("Sorry, I lost the previous record." & vbCr & _
                                   "Please repeat the action." & _
                                 "|Internal error", "|")
                End If
            End If
            If Len(Join(MsgTxt)) Then
                MsgBox MsgTxt(0), vbCritical, MsgTxt(1)
                Application.Undo
                .Select
                Exit Sub
            End If
            
            Employee = ""        ' add empl name vlookup formula here
            For i = 1 To 8
                Log(i) = Array(Environ("username"), Employee, Now, _
                               ActiveSheet.Name, Cells(.Row, NwsClmJ).Value, _
                               .Address(0, 0), PrevVal(1)(1, .Column), _
                               .Value)(i - 1)
            Next i
            
            For i = 9 To 12
                Log(i) = PrevVal(1)(1, NwsClmJJ + i - 9)
                Log(i + 4) = Cells(.Row, NwsClmJJ + i - 9).Value
            Next i
            ' column 17 remains blank by your design
            
            For i = 18 To 21
                Log(i) = PrevVal(1)(1, NwsClmMP + i - 18)
                Log(i + 4) = Cells(.Row, NwsClmMP + i - 18).Value
            Next i
            ' column 26 remains blank by your design
            
            For i = 27 To 30
                Log(i) = PrevVal(1)(1, NwsClmPV + i - 27)
                Log(i + 4) = Cells(.Row, NwsClmPV + i - 27).Value
            Next i
        
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
            End With
            
            With Worksheets("Log")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1) _
                       .Resize(1, UBound(Log)).Value = Log
            End With
                
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
        End If
    End With
End Sub

Private Function SetPrevVal(ByVal R As Long) As Range
    ' 147
    
    Dim Rl      As Long         ' last used row in column [270]
    
    ' presuming that column 1 offers a relevant measurement
    Rl = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' don't record if the selection is in or above the caption row (NwsHeaderRow)
    ' or below the data range as defined by the end of 'FirstCl'
    ' you might add an exception for columns < `NwsClmJJ` ??
    If (R > NwsHeaderRow) And (R <= Rl) Then
        PrevVal(0) = R
        ' presuming that there is a header for every column in Header Row
        PrevVal(1) = DataRange(R).Value
    End If
End Function

Private Function DataRange(ByVal R As Long) As Range
    ' 147
    
    ' presuming that there is a header for every column in the Header Row
    Set DataRange = Range(Cells(R, 1), Cells(NwsHeaderRow, Columns.Count).End(xlToLeft) _
                          .Offset(R - NwsHeaderRow))
End Function

Из-за отсутствия данных я провел очень ограниченное тестирование этого кода: он создает запись в журнале, в основном в соответствии с тем, что предлагает ваш код. Как только вы освоите его, он станет таким же прозрачным, как и ваш собственный, что дает мне надежду, что вы сможете следовать ему и, например, вставить отсутствующее имя сотрудника. Добавить дату или столбцы очень просто, и это намного быстрее, чем то, что у вас было. Также есть довольно много комментариев, которые должны оказаться полезными.

Два слова о «старых» ценностях. Я заменил ваши многочисленные общедоступные переменные одним массивом, который записывает все данные в одну строку. Это происходит при загрузке (активации) листа и после этого при каждом щелчке. Если по какой-либо причине (что чаще всего происходит во время тестирования) массив недоступен или доступен не тот массив, пользователю будет предложено повторить изменение. Он довольно водонепроницаем.

вау, спасибо...! я обязательно разберусь с этим. стоит взяться за обучение!

GD-9 27.12.2020 00:01

это, безусловно, более быстрая регистрация подхода к данным. я вставил новый документ excel с данными, программа работала почти без проблем. мне пришлось удалить часть аргумента if counterlarge. он работал при множественном выборе манипулирования пустыми ячейками, но когда вы делали это с несколькими фактическими ячейками данных, он выдавал ошибку. другой - отображает ли NwsHeaderRow? я не могу найти вывод ни на ws. спасибо за любые дополнительные идеи.

GD-9 27.12.2020 18:05

Я изменил свой код, чтобы использовать Target.Cells.CountLarge вместо Target.CountLarge. Ни одно из перечислений не отображается на листе. Они служат для присвоения имен числам, и эти имена используются во всем коде вместо жестких чисел. Например. NwsHeaderRow = 2, потому что ваша строка заголовка находится в строке листа 2. Если вы переместите ее в строку 1 или 3, вы можете просто изменить значение, присвоенное перечислению NwsHeaderRow, и остальная часть кода автоматически адаптируется к изменению.

Variatus 28.12.2020 01:15

Кстати, я считаю, что не все имена, указанные в Enum, были фактически использованы в коде. Это легко убрать, если это вас беспокоит. Я оставил его нетронутым, потому что он показывает логику, реализованную в Enum.

Variatus 28.12.2020 01:17

Мне удалось заставить встречные аргументы (обмен сообщениями) работать должным образом. Далее я собираюсь посмотреть на расположение отображения NwsHeaderRow. Мне нравится направление, в котором меня ведет этот код, любые дополнительные идеи будут приветствоваться.

GD-9 28.12.2020 03:06

Когда вы почитаете перечисления (learn.microsoft.com/en-us/office/vba/language/reference/… ), вы обнаружите, что имя моего перечисления — Nws. Следовательно, первое перечисление может быть HeaderRow = 2. Код может относиться к этому номеру просто как HeaderRow.. Мне это не нравится, потому что в моих кодах HeaderRow будет переменной или объектом диапазона. Я также не люблю использовать полное название перечисления Nws.HeaderRow, потому что, опять же, точка обозначает что-то другое. Поэтому я называю его Nws.NwsHeaderRow`, но никогда не использую полное имя.

Variatus 28.12.2020 07:45

спасибо интересно читать. я хотел вывести и показать значение HeaderRow в журнале ws. я смог отобразить это значение, так что теперь я хорошо разбираюсь в коде. спасибо за всю помощь и идеи. я должен одобрить этот ответ для вас?

GD-9 28.12.2020 16:04

Другие вопросы по теме