#excel #vba #events #target #worksheet-function
#excel #vba #Мероприятия #цель #рабочий лист-функция
Вопрос:
ССЫЛКА: Отслеживание изменений на листе, копирование ячейки, которая не является активной ячейкой в строке активной ячейки, и запись значения
Я обновил свой рабочий лист и надеюсь получить представление о том, как получать значения в ячейках при изменении события…
- NewColumn__Value — в настоящее время ни один из них не извлекает правильное значение. активная ячейка влияет на результаты и требует изменения до и после события, чтобы сравнить позже. я знаю, что в настоящее время он выводит то же самое, что и соответствующий OldVColumn_Value, но оставлен, чтобы помочь с передачей ask.
- 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" amp; 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
Комментарии:
1. Я не уверен, в чем заключается вопрос, но я бы, вероятно, попытался использовать словарь вместо длинного списка переменных и перебирать его там, где это возможно.
2. В основном спрашиваю о 2 вещах.. Во-первых, когда изменяется активная ячейка, скажем, R13, это влияет на значения других ячеек в этой строке. Я хочу скопировать эти значения и поместить в logdetails ws. Все хорошо с получением старых значений до изменения из Col JJ13: JM13, MP13: MS13 и PV13: PY13 (и т.д.), Но также необходимо записать значения после изменения тех же ячеек. Изменение в R13 влияет на эти ячейки, и я хочу записать значения до / после изменения. Затем выведите данные на вкладку logdetails с другими значениями. Во-вторых, там, где происходит активное изменение ячейки, запишите заголовок столбца, расположенный в строке 2
3. Если каждое изменение записывается по своему новому значению, то нет необходимости записывать и предыдущее значение в это время, поскольку оно уже есть в журнале, записанном при последнем изменении.
4. мне кажется, я понимаю вас. да, я пытался использовать эти значения при изменении следующей ячейки. я не могу получить значения, помещенные в правильную строку, где они должны быть для последующего анализа. его нужно сдвинуть вверх на 1 ряд. он хочет поместить все данные в logdetails в одной строке, независимо от того, на какое смещение строки я их меняю.
5. я смог использовать старые значения в другом подходе, так что я хорош. спасибо за все идеи.
Ответ №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." amp; _
"|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." amp; vbCr amp; _
"Please repeat the action." amp; _
"|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
Из-за нехватки данных я провел очень ограниченное тестирование этого кода: он создает запись в журнале, в основном в соответствии с тем, что, по-видимому, предлагает ваш код. Как только вы освоитесь, он будет таким же прозрачным, как и ваш собственный, что дает мне надежду, что вы сможете следовать ему и, например, вставить отсутствующее имя сотрудника. Добавить дату или столбцы очень легко, и это намного быстрее, чем то, что у вас было. Также есть немало комментариев, которые должны оказаться полезными.
Одно слово о «старых» значениях. Я заменил ваши многочисленные общедоступные переменные одним массивом, который записывает все данные в одну строку. Это происходит при загрузке (активации) листа и после этого при каждом нажатии. Если по какой-либо причине (что чаще всего происходит во время тестирования) массив недоступен или доступен неправильный массив, пользователю будет предложено повторить его изменение. Это довольно водонепроницаемо.
Комментарии:
1. вау, спасибо …! я обязательно разберусь с этим. стоит учиться!
2. это, безусловно, более быстрый подход к протоколированию данных. я ввел новый документ Excel с данными, программа работала почти без проблем. мне пришлось удалить часть аргумента if counterlarge. это работало при множественном выборе пустой ячейки, но когда вы выполняли с фактическими несколькими ячейками данных, это приводило к ошибкам. другой вопрос, отображается ли NwsHeaderRow? я не могу найти вывод ни на ws. спасибо за любую дополнительную информацию.
3. Я изменил свой код, чтобы использовать
Target.Cells.CountLargeвместоTarget.CountLarge. Ни одно из перечислений не отображается на рабочем листе. Они служат для присвоения имен числам, и эти имена используются во всем коде вместо жестких чисел. Например, NwsHeaderRow = 2 , потому что ваша строка заголовка находится в строке листа 2. Если вы хотите переместить его в строку 1 или 3, вы можете просто изменить значение, присвоенное перечислению NwsHeaderRow, и остальная часть кода автоматически адаптируется к изменению.4. Кстати, я полагаю, что не все имена, приведенные в Перечислении, на самом деле были окончательно использованы в коде. Это легко исправить, если это вас беспокоит. Я оставил его нетронутым, потому что он показывает логику, реализованную в Перечислении.
5. мне удалось заставить встречные аргументы (обмен сообщениями) работать должным образом. далее я собираюсь посмотреть на расположение отображения NwsHeaderRow. мне нравится направление, в котором этот код ведет меня, любые дальнейшие идеи будут приветствоваться.