隣接する3つのセルがすべて空白になる場合は、セルを空白にします。

Question

VBAおよび一般的なコーディングでは非常に慣れていません。

私は、Aという列がジョブ番号であるスプレッドシートで作業しています。
列Bは日付です。
列CDEパターンを持たないE.G Textにマークを付ける必要があります。

は今、私は任意のマークが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列が変更され、少なくとも1つが空白でない場合に、列Bに日付を挿入します。 3つのすべてが空白の場合は逆に、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

は、あなただけのチェックを追加しdateCellは、日付が現在の行に存在する細胞をある

If Target.Value = "" Then dateCell.ClearContents 

しかし、あなたはまた、次の条件を満たす必要があります。

1. 有効/無効のイベント

   「日付」セルを変更するときに再びWorksheet_Change()火災を防止する

   （すべての3つの列

   を処理するセル値

2. 使用一つのサブを削除するとき、これはまた、発生したターゲットはE.に列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