vba - Worksheet_change : entire column value deleted, 在此操作之前识别非空单元格

Question

我有一个带有用于输入的主工作表的工作簿，并且根据主工作表中“类型”列的单元格值将主工作表中的值复制到 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提高速度