#excel #vba
Вопрос:
У меня есть код, который в основном делает следующее: я хочу получить доступ к двум триггерам или целевым значениям и, основываясь на их соответствующих значениях, выполнить действие. Экс:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 19 And Target.row = 17 Then
If Target.Value = "Yes" Then
'do something
End if
End Sub
If Target.Column = 20 And Target.row = 18 Then
If Target.Value = "Yes" Then
'do something
End if
End Sub
Что это делает, так это проверяет только одно значение триггера за раз. Когда триггер 1.значение изменяется, он не проверяет триггер 2.значение
Однако то, что я действительно хотел сделать, это:
if triger1.value = "Yes" and triger2.value = "yes" then
'' do something
elseif triger1.value = "No" and triger2.value = "yes"
'' do another thing
end if
and so on
теперь мой вопрос: как я могу получить доступ к двум триггерам одновременно, и если значение одного триггера будет обновлено, он проверит значение второго триггера и решит, что делать. Любая помощь или предложение высоко ценятся!
Ответ №1:
Я думаю, ты хочешь чего-то подобного:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim trigger1 As Range, trigger2 As Range
Set trigger1 = Me.Range("S17")
Set trigger2 = Me.Range("T18")
If Not Intersect(Target, Union(trigger1, trigger2)) Is Nothing Then
If trigger1.Value = "Yes" And trigger2.Value = "Yes" Then
'do something
End If
End If
End Sub
Каждый раз, когда какой-либо из триггеров изменяется, это будет проверять, установлены ли оба триггера на «Да». Если они есть, то код будет запущен (если вы измените «сделать что-то» на необходимые функции).
Ответ №2:
Пожалуйста, удалите первую end sub
строку в вашем макросе: в этот момент ваш макрос останавливается, а остальные строки больше даже не читаются.
Комментарии:
1. Я думаю, что у OP есть
End Sub
там, потому что они попытались объединить две подсистемы, чтобы получить желаемую функциональность. К сожалению , они ушлиEnd Sub
, так что ему было суждено даже не компилироваться. Однако, даже если они удалятEnd Sub
код , он все равно не будет работать так, как они хотят (оба триггера проверяются вместе).
Ответ №3:
Для сложных проверок вы можете использовать логическое значение для хранения значения True/False и проверить это позже.
Dim bContinue AS Boolean
bContinue = False
If Target.Column = 19 And Target.row = 17 Then bContinue = True
If Target.Column = 20 And Target.row = 18 Then bContinue = True
If bContinue = True Then
'If Trigger1...
End If
Однако ваш текущий код достаточно прост, чтобы OR
он работал:
If (Target.Column = 19 And Target.row = 17) OR (Target.Column = 20 And Target.row = 18) Then
После этого в строке 18 появится столбец 20 листа Me.Cells(18, 20)
. Аналогично, строка 17, столбец 19 будут Me.Cells(17, 19)
Это позволяет вам сделать это:
If Me.Cells(17, 19).Value = "Yes" And Me.Cells(18,20).Value = "Yes" Then
'Do Something
'' do something
elseif Me.Cells(17, 19).value = "No" and Me.Cells(18,20).value = "yes"
'' do another thing
end if
Однако, если единственными возможными значениями являются «Да» и «Нет» (т. Е. Нет «Может быть» или пусто), вы можете объединить все в оператор Switch с помощью двоичного кода:
Select Case (IIF(Me.Cells(17, 19).Value = "Yes", 1, 0) IIF(Me.Cells(18, 20).Value = "Yes", 2, 0))
Case 0: '0b00
'Both are "No"
Case 1: '0b01
'"Yes" and "No"
Case 2: '0b10
'"No" and "Yes"
Case 3: '0b11
'Both are "Yes"
Case Else:
'Something has gone wrong
End Select
( Worksheet_Change
Функция прикреплена к Рабочему листу, поэтому вы можете использовать специальное ключевое Me
слово для ссылки на рабочий лист. Если бы это был код в модуле, то это не сработало бы)
Комментарии:
1. 1 — действительно хорошее объяснение. Я думаю, что создание переменных из двух триггеров полезно, однако, чтобы вам не приходилось постоянно ссылаться на номера строк и столбцов (и, возможно, совершать неловкие ошибки!). Но это только мои предпочтения!
2. Это тоже было моим предпочтением, но срабатывает один триггер за раз. если триггер один срабатывает, а значение триггера два не обновляется или он его не читает.
Ответ №4:
Изменение Рабочего Листа (Несколько Ячеек)
Стандартный модуль, например Module1
Option Explicit
Sub TriggerS17T18( _
ByVal Target As Range)
' Needs the 'ConcatRange' function.
Const ProcName As String = "TriggerS17T18"
On Error GoTo ClearError
Const rgAddress As String = "S17,T18"
Dim sws As Worksheet: Set sws = Target.Worksheet
Dim rg As Range: Set rg = sws.Range(rgAddress)
If Intersect(Target, rg) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
' The following line is crucial if you're going to process the same
' worksheet, because it will prevent retriggering the event while it
' is still running.
Application.EnableEvents = False
Dim cString As String: cString = UCase(ConcatRange(rg))
' Possibly Needed References
' Create a reference to the workbook.
'Dim wb As Workbook: Set wb = sws.Parent ' Set wb = Target.Worksheet.Parent
' Create a reference to worksheet "Sheet2".
'Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
' When done testing, replace the `MsgBox cString` lines with your code.
Select Case cString
Case "YESYES"
MsgBox cString
Case "YESNO"
MsgBox cString
Case "NOYES"
MsgBox cString
Case "NONO"
MsgBox cString
Case Else
MsgBox cString
End Select
SafeExit:
If Not Application.EnableEvents Then Application.EnableEvents = True
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
Exit Sub
ClearError:
Debug.Print "'" amp; ProcName amp; "': Unexpected Error!" amp; vbLf _
amp; " " amp; "Run-time error '" amp; Err.Number amp; "':" amp; vbLf _
amp; " " amp; Err.Description
Resume SafeExit
End Sub
Function ConcatRange( _
ByVal mrg As Range, _
Optional ByVal Delimiter As String) _
As String
Const ProcName As String = "ConcatRange"
On Error GoTo ClearError
Dim mCell As Range
For Each mCell In mrg.Cells
ConcatRange = ConcatRange amp; CStr(mCell.Value) amp; Delimiter
Next
ConcatRange = Left(ConcatRange, Len(ConcatRange) - Len(Delimiter))
ProcExit:
Exit Function
ClearError:
Debug.Print "'" amp; ProcName amp; "': Unexpected Error!" amp; vbLf _
amp; " " amp; "Run-time error '" amp; Err.Number amp; "':" amp; vbLf _
amp; " " amp; Err.Description
Resume ProcExit
End Function
Модуль листа, например Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
TriggerS17T18 Target
End Sub