excel VBA合并重复行中的单元格注解

oewdyzsn 于 2023-03-13 发布在其他

关注(0)|答案(1)|浏览(214)

如果多个单元格注解重复，我正在尝试将它们合并在一起。
目前我的宏导入电缆长度数据，然后在计算重复行的数量后删除重复的数据。100Ft的数量7将只是一行700Ft的电缆。我遇到的问题是每行都有一个注解，说明该电缆是从哪里导入的。合并后，它只保留其中一个注解。我如何合并注解？

'Import Data
    If ws.Range("C" & c) = Chr(42) Then
        ws.Range("H" & c & ":L" & c).Copy Destination:=wsC.Range("A" & lr) '* New Circuit
        wsC.Range("B" & lr).AddComment wb.Name
        lr = lr + 1
    End If

'Remove Duplicates
    For x = lastrow To 7 Step -1
        For Y = 7 To lastrow
            If (.Cells(x, 1) = .Cells(Y, 1) And .Cells(x, 3) = .Cells(Y, 3) And _
                .Cells(x, 4) = .Cells(Y, 4) And .Cells(x, 5) = .Cells(Y, 5)) And x > Y Then
                .Cells(Y, 2) = .Cells(x, 2) + .Cells(Y, 2)
                Rows(x).EntireRow.Delete
                Exit For
            End If
        Next Y
    Next x

谢谢你的帮助

excel

来源：https://stackoverflow.com/questions/75652610/vba-to-combine-cell-comments-from-duplicate-rows

1条答案

按热度按时间

xxls0lw81#

用换行符连接注解。

Option Explicit

Sub Summate()

   Const FIRSTROW = 7

   Dim ws As Worksheet, s As String
   Dim lastrow As Long, x As Long, y As Long
   
   Set ws = ThisWorkbook.Sheets("Sheet1")
   With ws
       lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
       For x = lastrow To FIRSTROW Step -1
          For y = FIRSTROW  to x-1
             If .Cells(y, 1) = .Cells(x, 1) And _
                .Cells(y, 3) = .Cells(x, 3) And _
                .Cells(y, 4) = .Cells(x, 4) And _
                .Cells(y, 5) = .Cells(x, 5) Then
                    ' summate qu
                    .Cells(y, 2) = .Cells(y, 2) + .Cells(x, 2)
                    ' concat comments
                    If .Cells(x, 2).Comment Is Nothing Then
                        ' skip
                    Else
                        s = .Cells(x, 2).Comment.Text
                        If .Cells(y, 2).Comment Is Nothing Then
                           .Cells(y, 2).AddComment s
                        Else
                           ' insert text
                           .Cells(y, 2).Comment.Text vbLf & s, Len(s) + 1, False
                        End If
                    End If
                    .Rows(x).EntireRow.Delete 'test with .Interior.Color = vbRed
                    Exit For
              End If
          Next
       Next
   End With
   MsgBox "done"
End Sub

赞(0）回复(0）举报 2023-03-13

我来回答

excel VBA合并重复行中的单元格注解

1条答案

相关问题

热门标签

最新问答