如果所有三个相邻的细胞变为空白，则将单元格空白

Question

我对VBA和一般编码非常没有经验。

我正在使用A列是工作编号的电子表格。
B列是日期。
列C，D和E您必须在没有模式的文本中放置一个标记。

现在，如果在C，D或E中放置任何标记，我已经制定了代码将日期放入B列中。但是，如果您然后删除C，D或E B列中的单元格仍在日期中填充。

为了清楚C，D或E可以在其中或2或1上有文本。

现在我知道您可以删除单元格，但是在哪里很有趣。

这是我到目前为止的代码

Private Sub Worksheet_Change(ByVal Target As Range)    
    Call Macro1(Target)
    Call Macro2(Target)
    Call Macro3(Target)
End Sub
Sub Macro1(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("c2:c100")) Is Nothing Then
        With Target(1, 0)
            .Value = Date
            .EntireColumn.AutoFit
        End With
    End If
End Sub
Sub Macro2(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("d2:d100")) Is Nothing Then
        With Target(1, -1)
            .Value = Date
            .EntireColumn.AutoFit
        End With
    End If
End Sub
Sub Macro3(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("e2:e100")) Is Nothing Then
        With Target(1, -2)
            .Value = Date
            .EntireColumn.AutoFit
        End With
    End If
End Sub

Answer 1

此代码要么在更改该行C，d或e列时插入B列中的日期，而且其中至少一个是非空白的。相反，如果这三个均为空白，则清除B中的单元格：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("c2:E100")) Is Nothing Then
    With Intersect(Target.EntireRow, Me.Range("B2:B100"))
        If WorksheetFunction.CountBlank(Intersect(Target.EntireRow, Me.Range("C2:E100"))) <> 3 Then
            .Value = Date
            .EntireColumn.AutoFit
        Else
            .Value = ""
        End If
    End With
End If
End Sub

Answer 2

您只需添加检查

 If Target.Value = "" Then dateCell.ClearContents

datecell是日期驻留在当前行中的单元

，但您也必须：

1. 禁用/启用事件

   更改"日期"单元格时再次防止Worksheet_Change()发射（这也会在删除单元格值

时发生

2. 使用一个子处理所有三列

   只需检查目标是否与E相交。

   If Not Intersect(.Cells, Range("C:E")) Is Nothing Then
   

请参阅代码：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Call Macro1(Target)
End Sub
Sub Macro1(ByVal Target As Range)
    Dim dateCell As Range
    With Target
        If .Cells.Count > 1 Then Exit Sub
        Application.EnableEvents = False '<--| disable events to prevent this one fire when changing "date" cell
        If Not Intersect(.Cells, Range("C:E")) Is Nothing Then
            Set dateCell = Cells(.row, "B") '<--| set the cell where "date" resides
            If Application.WorksheetFunction.CountA(.Parent.Cells(.row, "C").Resize(, 3)) = 0 Then '<--| if there are no values in current row columns C to E ...
                dateCell.ClearContents '<--|... clear the date
            Else
                dateCell.Value = Date '<--|... otherwise put the date in column B and ...
                dateCell.EntireColumn.AutoFit '<--| ... autofit column B
            End If
        End If
        Application.EnableEvents = True '<--| enable events back on
    End With
End Sub