首先，您还没有发布您正在使用的确切sub，但假设它是Worksheet_Change，它不会因单元格格式更改而触发。对此，请使用Worksheet_SelectionChange。
如果假设除了要提取的标题之外，单元格将始终为空，那么迭代直到到达非空单元格将有效：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Interior.Color = RGB(255,255,0) Then 
' Set this to the exact color or flip the statement so it's:
' If Target.Interior.Color <> RGB(0,0,0) Then
    Dim r As Integer
    Dim c As Integer
    Dim staff As String
    Dim date As String
    r = 0
    c = 0
    While Target.Offset(r,0) <> ""
        r = r - 1
    Wend
    While Target.Offset(0,c) <> ""
        c = c - 1
    Wend
' These move through the row (and then the column) until a non empty cell is found
    staff = Target.Offset(0,c).Value
    date = Target.Offset(r,0).Value & Target.Offset(r-2,0).Value
' Get the string values; need to append the two day then date values
End If
End Sub

字符串
如果成功了告诉我。

**编辑：**在选择多个日期的情况下，每次更改颜色都会触发Change事件。考虑一下，创建一个FormControl按钮并将宏链接到该按钮可能会更好，这样就不会在单元格颜色更改后立即发送电子邮件。
**编辑2：**这是您修改后的问题的更新代码。如果成功了告诉我。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

' Start with the conditional
If Target.Interior.Color = RGB(255,0,0) Then

Dim xDateSelected As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String

On Error Resume Next

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim r As Integer
Dim c As Integer
Dim staff As String
Dim date1 As String

r = 0
c = 0
While Target.Offset(r, 0) = ""
    r = r - 1
Wend
While Target.Offset(0, c) = ""
    c = c - 1
Wend
'These move through the row (and then the column) until a non empty cell is found

staff = Target.Offset(0, c).Value
date1 = Target.Offset(r, 0).Value & Target.Offset(r - 2, c).Value
'I use r-2, c here to get the date, assuming it is a merged cell which have weird behaviour
'Get the string values; need to append the two day then date values

Set xDateSelected = Range(date1).Value ' Keep in mind you must either reference the cell itself 
' or a variable storing a string with the cell reference

Set Mydate = Intersect(Target, xDateSelected)
ActiveWorkbook.Save

If Not Mydate Is Nothing Then
    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailItem = xOutApp.CreateItem(0)
'code to retrieve content from affected cells and putting into email content ie "staff name" is applying for leave on "date"

    xMailBody = "Hi there Priscilla" & vbNewLine & vbNewLine & _
    "Name: " & staff & " is applying for Ad-hoc leave on " & date1 & vbNewLine & vbNewLine & _
    "Reason: " & vbNewLine & vbNewLine & _
    "Thank you" & vbNewLine 'calling out and placing values of each col into email body

    With xMailItem
        .To = "foong.jia.yi1@nhcs.com.sg"
        .Subject = "Applying for Ad-hoc leave "
        .Body = xMailBody
        .Attachments.Add (ThisWorkbook.FullName)
        .Display
    End With
    Set xRgSel = Nothing
    Set xOutApp = Nothing
    Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
End Sub

型