如果其他列中的单元格包含值，则向单元格添加注释

Question

我有一个代码，它结合了 C:F 列中所有单元格的单元格内容，并将其放入 B 列的注释中 - 每行。 我现在只需要将其应用于在各自的 A 列中有内容的行。

单元格 A2 里面有东西，所以把 C2:F2 的内容放到 B2 的注释中。 单元格 A3 中没有任何内容，因此不要向该单元格添加注释。 单元格A4又有东西了，把C4:F4的内容放到B4的注释里面。

表格如下所示：Table

到目前为止，我的代码如下所示：

Sub Test()
    Dim LRow As Integer
    
    With ActiveSheet
        For LRow = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Range(Cells(LRow, 3), Cells(LRow, 6)).Select
        
        Dim c As Range, s As String

        With Cells(LRow, 2)
            .ClearComments
            For Each c In Selection
            'If c.Offset(0, -2) <> "" Then
                'On Error Resume Next
                If c <> "" Then s = IIf(s = "", c, s & Chr(10) & c)
                Next c
                .AddCommentThreaded "Test:" & Chr(10) & s
        End With
        s = ""
        Next LRow
    End With
End Sub

现在的问题是我无法让 A 列中的内容检查正常工作。有人对如何使该位起作用有任何提示吗？

Answer 1

试试下面的方法。还有checkout how to avoid select和why use long instead of integer

Sub Test()
    Dim LRow As Long, aCell As Range, ws As Worksheet
    Set ws = ActiveSheet
    
    With ws
    
        For LRow = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If .Cells(LRow, 1).Value <> "" Then
                Dim theComment As String
                theComment = ""
                
                For Each aCell In Intersect(Range("C:F"), .Rows(LRow)).Cells
                    theComment = theComment & aCell.Value
                Next aCell
    
            With .Cells(LRow, 2)
                .ClearComments
                    .AddCommentThreaded "Test:" & Chr(10) & theComment
            End With
            End If
            
        Next LRow
    End With
End Sub