Question

我有一个带有主页的工作簿用于输入，主表中的值将根据＆＃34; type＆＃34;的单元格值复制到2个子表。主页中的专栏。

＆＃34;评论＆＃34;中的任何值子页面中针对这些复制的单元格的列作为注释添加到主页的相应行中。当＆＃34;注释中的值为＆＃34;子工作表中的列会立即删除，我想在此操作之前识别非空单元格并删除主工作表中的相应注释。

目前，如果在＆＃34;评论＆＃34;中添加/删除了值，我已经编写了代码。子工作表中的列，然后在主工作表的相应条目中添加/删除注释。

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

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

1 个答案: