excel - 如何使用第 1 列中的每个值从 2 个不同的列添加评论(注)？

Question

我需要一种动态的方式来添加备注 在我的 中的哪个单元格中ID 列 A .但是，注释需要使用 B 列和 C 列中的信息。例如: 2020 年 1 月 13 日，安妮 .
我不确定如何检查 中每个值的次数A栏将出现并使用来自 的信息D 和 B 列 创建评论(注意)..

我需要的结果。 ID 号始终相同，注释也必须相同。

我正在使用的代码是

Sub Cmt_test()

Sheet1.Range("A2").AddComment "On " & Sheet1.Range("D2") & ", " & Sheet1.Range("B2")

End Sub

我不知道如何让它动态地在同一 ID 出现时始终获取信息。也许如果我在 上使用循环A栏循环是否有可能一直使用 D 和 B 列中的信息找到相同的 ID 来添加评论？

Answer 1

为列中的每个单元格写注释

Option Explicit

Sub addComments()
    
    Const wsName As String = "Sheet1"
    Const FirstRow As Long = 2
    Const LastRowCol As Long = 1 ' or "A"
    Const str1 As String = "On "
    Const str2 As String = ", "
    Dim Cols As Variant: Cols = Array(1, 2, 4)
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim LastRow: LastRow = ws.Cells(ws.Rows.Count, LastRowCol).End(xlUp).Row
    Dim Vals As Variant: ReDim Vals(UBound(Cols))
    
    ' Define Source Range.
    Dim rng As Range: Set rng = ws.Range(ws.Cells(FirstRow, Cols(0)), _
                           ws.Cells(LastRow, Cols(0)))
    
    ' Write Column Ranges to Arrays.
    Dim j As Long
    For j = 0 To UBound(Cols)
        Vals(j) = rng.Offset(, Cols(j) - Cols(0))
    Next j
    
    ' Loop through elements (rows) of Source Array
    ' and write comments to a dictionary.
    Dim dict As Object, Curr As Variant, i As Long
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Vals(0))
         Curr = Vals(0)(i, 1)
         If dict(Curr) <> "" Then
             dict(Curr) = dict(Curr) & vbLf & str1 _
               & Format(Vals(2)(i, 1), "mm/dd/yyyy") & str2 & Vals(1)(i, 1)
         Else
             dict(Curr) = str1 _
               & Format(Vals(2)(i, 1), "mm/dd/yyyy") & str2 & Vals(1)(i, 1)
         End If
    Next i
     
    ' Write comments from the dictionary to Source Range.
    rng.ClearComments
    Dim cel As Range
    For Each cel In rng.Cells
        cel.AddComment dict(cel.Value)
    Next cel

End Sub