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

我对VBA和编码一般都不熟悉。

我正在制作一个电子表格，其中列A是工作号码。
B列是date。
列C ， D和E你必须在EG文本中标记没有模式的标记。

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

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

现在我知道你可以删除这个单元格，但是那里有趣。

这里是我到目前为止的代码，请随意build议的方式，使其更小或清除它，但主要是提前感谢我的问题。

 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

此代码在列B中的列C，D或E发生更改并且其中至less有一个非空时，会在列B中插入date。 相反，如果所有三个都是空白的，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是date驻留在当前行的单元格

但你也必须：

1. 禁用/启用事件

   防止更改“date”单元格时再次触发Worksheet_Change() （这也会在删除单元格值时发生

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

   只是检查目标是否与列C到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