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列中插入日期。相反，如果所有三个都是空白的，则清除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是日期所在的单元格

但您还必须：

禁用/启用事件

在更改＆＃34; date＆＃34;时再次阻止Worksheet_Change()点火单元格（删除单元格值时也会出现这种情况
使用一个子句来处理所有三列

检查目标是否与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

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

2 个答案: