Worksheet_change：删除整个列值，在此操作之前识别非空单元格

我有一个工作簿，用于input主表单，主表单中的值根据主表单中“types”列的单元格值复制到2个子表单中。

子表单中的“注释”列中的任何值都将作为注释添加到主表单的相应行中。当子表单中的“注释”列中的值一次性删除时，我想标识在这个动作之前的非空单元格，并删除主表中的相应注释。

目前我已经编写了代码，如果在子表单的“注释”列中添加/删除了一个值，然后在主表单的相应条目中添加/删除注释。

Private Sub Worksheet_Change(ByVal Target As Range) Dim temp As String Dim tem As String With Target If .Count = 1 And .Column = 8 And .Row < 600 Then tem = .Row If Sheets("Parts- input").Cells(tem, 8).Comment Is Nothing Then If Sheets("Pins").Cells(.Row, .Column).Value = "" Then Sheets("Parts- input").Cells(tem, 8).Comment.Delete Else Sheets("Parts- input").Cells(tem, 8).AddComment "Lifts Sheet: " & Sheets("Pins").Cells(.Row, .Column).Value End If Else If Sheets("Pins").Cells(.Row, .Column).Value = "" Then Sheets("Parts- input").Cells(tem, 8).Comment.Delete Else Sheets("Parts- input").Cells(tem, 8).Comment.Text "Lifts Sheet: " & Sheets("Pins").Cells(.Row, .Column).Value End If End If End If End With End Sub 

Answer 1

只是玩你的代码，我想这个：

 Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count = 1 And .Column = 8 And .row < 600 Then If Sheets("Pins").Cells(.row, .Column).Value = "" Then Sheets("Parts- input").Cells(.row, 8).Comment.Delete Else If Sheets("Parts- input").Cells(.row, 8).Comment Is Nothing Then Sheets("Parts- input").Cells(.row, 8).AddComment "Lifts Sheet: " & Sheets("Pins").Cells(.row, .Column).Value Else Sheets("Parts- input").Cells(.row, 8).Comment.Text "Lifts Sheet: " & Sheets("Pins").Cells(.row, .Column).Value End If End If Else If Not Intersect(Target, Target.Parent.Range("H1:H599")) Is Nothing Then Dim runner As Range, rng As Range For Each runner In Intersect(Target, Target.Parent.Range("H1:H599")).Cells If Sheets("Pins").Cells(runner.row, 8).Value = "" Then If rng Is Nothing Then Set rng = Sheets("Parts- input").Cells(runner.Rows, 8) Else Set rng = Union(rng, Sheets("Parts- input").Cells(runner.Rows, 8)) End If End If End If Next rng.Comment.Delete End If End With End Sub 

你可以直接删除它们，但是有很多单元格，一步完成会更快

编辑包括Intersect以提高速度