Одновременный доступ к целевым значениям в vba

#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