繁体   English   中英

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

[英]Excel VBA Add comment to cell if cell in other column contains value

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

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

该表看起来像这样:

到目前为止,我的代码如下所示:

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 列中进行内容检查。 有人对如何使该位起作用有任何提示吗?

试试下面的东西。 请查看如何避免 select以及为什么使用 long 而不是 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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM