当单元格在 VBA 中更改值时操作另一个单元格

Question

这就是全部。 就像我说的，当一次只有一个人在那里时，它们都可以工作。 我试着把它放在最后，开始。 抱歉，还在努力学习，所以我想看看我是否可以先解决问题。 没运气。

Option Explicit


Private prevVal

 

Private Sub Worksheet_Activate()

   prevVal = ActiveCell.Value 'memorize the value of the active cell

End Sub

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   prevVal = Target.Value     'memorize the value of the selected cell

End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not (Application.Intersect(Range("G1:G5000"), Target) Is Nothing) Then

        If prevVal <> "" Then

            Target.Offset(, 14).Value = "No" 'do the job only if prevVal was empty...

        End If

    End If

End Sub



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    
   
    
    Dim emailRng As Range, cl As Range
    Dim sTo As String
    Set emailRng = Worksheets("POC&Airport Codes&KEY").Range("D3:D4")

    If InStr(1, Target, "BPS", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D3:D5")
    ElseIf InStr(1, Target, "FRT", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D11:D15")
    ElseIf InStr(1, Target, "PG", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D64:D65")
          ElseIf InStr(1, Target, "CP", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D57")
    ElseIf InStr(1, Target, "CSC", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D37:D39")
          ElseIf InStr(1, Target, "CEN", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D28:D31")
    ElseIf InStr(1, Target, "AFI", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D69:D70")
    ElseIf InStr(1, Target, "ATLAS", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D79:D82")
    End If
    
    For Each cl In emailRng
        sTo = sTo & " ;" & cl.Value
    Next
    
    sTo = Mid(sTo, 2)
    If Target.CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
   
    Select Case Target.Column
        Case Is = 16
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = sTo
                .CC = "cs-requests@socosix.com"
                .Subject = Format(Range("F" & Target.Row), "#") & " " & Range("J" & Target.Row) & " " & Range("L" & Target.Row) & " " & Format(Range("A" & Target.Row), "dd-mmmm-yyyy") & " " & "CS"
                .HTMLBody = "Please see the attached transportation request and confirm service at your earliest convenience.  " & "<br>" _
                    & "Tail: " & Range("O" & Target.Row)
                .Display
                
            End With
    
    
        Case Is = 6
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = "njasecurity@netjets.com"
                .CC = "cs-requests@socosix.com; rmains@qssecurity.com"
                .Subject = "Crew Secure Ground Transport " & "/ " & Format(Range("A" & Target.Row), "mm-dd-yyyy") & " / " & Range("L" & Target.Row) & " / " & Range("O" & Target.Row)
                .HTMLBody = "Confirmation #: " & Format(Range("F" & Target.Row), "#") & "<br> " _
                    & "Date: " & Format(Range("A" & Target.Row), "mm-dd-yyyy") & "<br>" _
                    & "Time: " & Format(Range("A" & Target.Row), "hh:mm") & " L " & "<br>" _
                    & "Crew: " & Range("H" & Target.Row) & "<br>" _
                    & "<br>" _
                    & "<br>" _
                    & "Vehicle: " & Range("U" & Target.Row) & "<br>" _
                    & "Plate #: " & Range("V" & Target.Row) & "<br>" _
                    & "<br>" _
                    & "<br>" _
                    & "<br>" _
                    & "Driver: " & Range("S" & Target.Row) & "<br>" _
                    & "Cell Phone: " & "<br>" _
                    & "<br>" _
                    & "<br>" _
                    & "Should there be any issues regarding the aforementioned services, please contact our 24hr-Operations Center (614) 239-5412 or email NJASecurity@netjets.com."
                 .Display
            End With
            
        Case Is = 26
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = "WhatsApp Chat"
                .Subject = Format(Range("F" & Target.Row), "#")
                .HTMLBody = "Date: " & Format(Range("A" & Target.Row), "dd-mmmm-yy") & "<br>" _
                    & "Driver Arrival: " & Format(Range("D" & Target.Row), "hh:mm") & " L " & "<br>" _
                    & "PAX: " & Range("H" & Target.Row) & "<br>" _
                    & "Tail: " & Range("O" & Target.Row) & "<br>" _
                    & Range("M" & Target.Row) & " " & "to" & " " & Range("N" & Target.Row) & "<br>" _
                    & "Driver: Please assign and add to chat. "
                   .Display
            End With
    End Select
    Application.ScreenUpdating = False



End Sub

当他们都在场时，我遇到的一个错误是它无法设置 OutApp。

Answer 1

请复制要触发的工作表模块中的下一个代码：

Option Explicit

Private prevVal

Private Sub Worksheet_Activate()
   If ActiveCell.Column = 6 Then
       prevVal = ActiveCell.value 'memorize the value of the active cell
   End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Column = 6 Then
        prevVal = Target.value     'memorize the value of the selected cell
   End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not (Application.Intersect(Range("F1:F5000"), Target) Is Nothing) Then
        If prevVal <> "" Then
           Application.EnableEvents = False
            Target.Offset(, 3).value = "No" 'do the job only if prevVal was empty...
           Application.EnableEvents = True
        End If
    End If
End Sub

这个怎么运作：

1. 它需要被初始化（以记住活动单元格的值），因此您需要从工作表中退出并返回以触发Activate事件，这是第一次。 之后，当工作表被激活时，它就完成了它的工作......

2. SelectionChange事件在更改之前记住单元格的先前值。

3. 仅当prevVal不为空时， Change事件才起作用...