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

Question

我对VBA和一般编码非常缺乏经验。

我正在制作电子表格，其中列A是职位号码。
栏B是日期。
列CD和E你必须在E.G文本没有模式标记。

现在我已经制定了代码把日期B列，如果任何标记放在C，D或E。但是，如果删除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

该代码在列B中的列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. 使用一个子来处理所有的三列

   只是检查，如果目标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