Worksheet_change:删除整列值,在此操作之前标识非空单元格

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以提高速度