Поверните ячейку пустой, если все три соседние ячейки станут пустыми

Question

Я очень неопытен с VBA и кодированием в целом.

Я работаю над таблицей, где столбец A - это номера рабочих мест.
Столбец B Даты.
Столбцы C, D и 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

Этот код либо вставляет дату в столбце В, когда столбцы C, D или E в этой строке изменяются и по крайней мере один из них не является пустым. С другой стороны, ячейка в колонке 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 Е. как

   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