REF: отслеживать изменения на листе, копировать ячейку, которая не является активной ячейкой в активной строке ячеек, и записывать значение
Я обновил свой рабочий лист и надеюсь получить представление о том, как получить значения в ячейках при изменении события...
любые мысли о консолидации кода приветствуются. к я вынужден использовать подход «длинное деление», и так здорово видеть, как перейти к подходу «калькулятор», это помогает мне учиться.
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
В основном спрашивают 2 вещи. Во-первых, когда активная ячейка изменяется, скажем, R13, это влияет на значения других ячеек в этой строке. Я хочу скопировать эти значения и поместить в logdetails ws. Все хорошо с получением старых значений до изменения из Col JJ13: JM13, MP13: MS13 и PV13: PY13 (и т. д.), но также необходимо записать значения после изменения тех же ячеек. Изменение в R13 влияет на эти ячейки, и я хочу записать значения до/после изменения. Затем выведите на вкладке logdetails другие значения. Во-вторых, там, где есть активное изменение ячейки, запишите ColumnHeader, расположенный в строке 2.
Если каждое изменение записывается с его новым значением, нет необходимости также записывать предыдущее значение в это время, потому что оно уже находится в журнале, записано, когда оно было изменено в последний раз.
Я верю, что следую за тобой. да, я пытался использовать эти значения при изменении следующей ячейки. я не могу получить значения, помещенные в правильную строку, где они должны быть для последующего анализа. его нужно сдвинуть вверх на 1 строку. я хочу поместить все данные в logdetails в одну и ту же строку, независимо от того, какое смещение строки я их изменяю.
я смог использовать старые значения в другом подходе, так что я в порядке. спасибо за все идеи.
Я рад узнать из вашего комментария, что вы решили свою проблему. Отличная работа! Я действительно считал то, что вы взялись за эту задачу, весьма героическим и не хотел бы ни выбросить мою работу, ни лишить вас ее возможной пользы. Пожалуйста, обратите внимание.
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
Из-за отсутствия данных я провел очень ограниченное тестирование этого кода: он создает запись в журнале, в основном в соответствии с тем, что предлагает ваш код. Как только вы освоите его, он станет таким же прозрачным, как и ваш собственный, что дает мне надежду, что вы сможете следовать ему и, например, вставить отсутствующее имя сотрудника. Добавить дату или столбцы очень просто, и это намного быстрее, чем то, что у вас было. Также есть довольно много комментариев, которые должны оказаться полезными.
Два слова о «старых» ценностях. Я заменил ваши многочисленные общедоступные переменные одним массивом, который записывает все данные в одну строку. Это происходит при загрузке (активации) листа и после этого при каждом щелчке. Если по какой-либо причине (что чаще всего происходит во время тестирования) массив недоступен или доступен не тот массив, пользователю будет предложено повторить изменение. Он довольно водонепроницаем.
вау, спасибо...! я обязательно разберусь с этим. стоит взяться за обучение!
это, безусловно, более быстрая регистрация подхода к данным. я вставил новый документ excel с данными, программа работала почти без проблем. мне пришлось удалить часть аргумента if counterlarge. он работал при множественном выборе манипулирования пустыми ячейками, но когда вы делали это с несколькими фактическими ячейками данных, он выдавал ошибку. другой - отображает ли NwsHeaderRow? я не могу найти вывод ни на ws. спасибо за любые дополнительные идеи.
Я изменил свой код, чтобы использовать Target.Cells.CountLarge
вместо Target.CountLarge
. Ни одно из перечислений не отображается на листе. Они служат для присвоения имен числам, и эти имена используются во всем коде вместо жестких чисел. Например. NwsHeaderRow = 2, потому что ваша строка заголовка находится в строке листа 2. Если вы переместите ее в строку 1 или 3, вы можете просто изменить значение, присвоенное перечислению NwsHeaderRow, и остальная часть кода автоматически адаптируется к изменению.
Кстати, я считаю, что не все имена, указанные в Enum, были фактически использованы в коде. Это легко убрать, если это вас беспокоит. Я оставил его нетронутым, потому что он показывает логику, реализованную в Enum.
Мне удалось заставить встречные аргументы (обмен сообщениями) работать должным образом. Далее я собираюсь посмотреть на расположение отображения NwsHeaderRow. Мне нравится направление, в котором меня ведет этот код, любые дополнительные идеи будут приветствоваться.
Когда вы почитаете перечисления (learn.microsoft.com/en-us/office/vba/language/reference/… ), вы обнаружите, что имя моего перечисления — Nws. Следовательно, первое перечисление может быть HeaderRow = 2
. Код может относиться к этому номеру просто как HeaderRow.
. Мне это не нравится, потому что в моих кодах HeaderRow будет переменной или объектом диапазона. Я также не люблю использовать полное название перечисления Nws.HeaderRow
, потому что, опять же, точка обозначает что-то другое. Поэтому я называю его Nws.NwsHeaderRow`, но никогда не использую полное имя.
спасибо интересно читать. я хотел вывести и показать значение HeaderRow в журнале ws. я смог отобразить это значение, так что теперь я хорошо разбираюсь в коде. спасибо за всю помощь и идеи. я должен одобрить этот ответ для вас?
Я не уверен, в чем вопрос, но я бы, вероятно, попытался использовать словарь вместо длинного списка переменных и, где это возможно, прокрутить его.