Excel vba插入注释单元格与关键字

Question

甚至不知道该怎么问这个问题。我有一个excel维护计划(sheet1)。设备在A栏(冷冻)，日期在第1行。当我将维护操作放在计划中时，我经常需要添加注释。
表二的维护动作是上升的。其中一些列是:日期、维护操作和工人数量。表2中的一些列有我在表1(时间表)上手动输入的信息作为评论，工人的数量是我总是添加到评论中的一个。如果我不用把这些都打进去，那就省了不少时间。我想创造的是:Sheet2有维护操作发生的日期，sheet1的日期横跨顶部。我想有一个宏在sheet1中找到与sheet2中的日期匹配的日期列，然后在sheet1中找到与sheet2中的设备id匹配的行，用于该维护操作。然后，可以将注释编译为sheet2中的行信息的字符串，并将其写入sheet1上的注释。

就像这样。单击sheet2上的按钮。它在sheet1上找到与日期列和设备行对齐的单元格。编译来自sheet2单元格b3、b4、b5的注释。在sheet1中找到的单元格中插入注释。然后循环sheet2上的每个维护操作。在插入新单元格之前，应该清除找到的单元格的所有注释。

有人有什么想法吗?或者给我指个方向?谢谢你的帮助。

Answer 1

感谢大家的帮助!在别处找到了一些答案。如果有人感兴趣，这是我的想法。

Sub setComment4Tour()
On Error GoTo hell
 Dim wrow As Range
 Dim id, AC As String
 Dim SearchRange As Range
 Dim wcol As Range
 Dim fdate As Date
 Dim fcell As Range
If Not Intersect(ActiveCell, Range("aa:aa")) Is Nothing Then 'check for current sheet activecell value in other sheet range
    If Range("A" & ActiveCell.row) <> "" And Range("C" & ActiveCell.row) <> "" Then 'check for values in current sheet col A & C
 id = ActiveCell.Value
 fdate = Range("C" & ActiveCell.row).Value
 'Find row ref
 Set wrow = Worksheets("WEEKLY").Range("a4:a13").Find(id, lookat:=xlPart)
 If Not wrow Is Nothing Then
 End If
 'Find column ref
 Set SearchRange = Worksheets("WEEKLY").Range("3:3")
 Set wcol = SearchRange.Find(fdate, LookIn:=xlValues, lookat:=xlWhole)
 Set fcell = Worksheets("WEEKLY").Cells(wrow.row, wcol.Column) 'combine row and column to get target cell
    If Not InStr(UCase(fcell), "TOUR") <> 0 Then
    mb1 = MsgBox("The WEEKLY does not have a tour scheduled for " & id & "." & Chr(10) & "Would you like to create the info comment for " & id & " anyway?", vbYesNo, " Tour Not Found!")
        If mb1 = vbYes Then
            GoTo updateComment 'Resume Next
        Else
            GoTo hell
        End If
    End If
'MsgBox "cell " & fcell.Address
updateComment:
'new comment based on current sheet info in the activecell row
newcmnt = Range("A" & ActiveCell.row).Value & Chr(10) & Range("D" & ActiveCell.row).Value & "-" & Range("E" & ActiveCell.row).Value & Chr(10) & "Adults " & Range("F" & ActiveCell.row).Value & Chr(10) & "Children " & Range("G" & ActiveCell.row).Value
    If fcell.Comment Is Nothing Then
        'Set ctext = Worksheets("WEEKLY").Cells(wrow.row, wcol.Column).Comment
        'fcell.Comment.Text Text:=atext
        fcell.AddComment Text:=newcmnt
        fcell.Comment.Shape.TextFrame.AutoSize = True
        MsgBox "comment added"
    ElseIf InStr(fcell.Comment.Text, Range("A" & ActiveCell.row).Value) <> 0 Then 'check if comment title already exists
        MsgBox "Tour " & Range("A" & ActiveCell.row).Value & "'s info comment already exists on the WEEKLY."
    Else 'ammend current comment with additional comment
        cmnt = fcell.Comment.Text
        newcmnt = cmnt & Chr(10) & Chr(10) & Range("A" & ActiveCell.row).Value & Chr(10) & Range("D" & ActiveCell.row).Value & "-" & Range("E" & ActiveCell.row).Value & Chr(10) & "Adults " & Range("F" & ActiveCell.row).Value & Chr(10) & "Children " & Range("G" & ActiveCell.row).Value
        fcell.Comment.Text Text:=newcmnt
        fcell.Comment.Shape.TextFrame.AutoSize = True
        MsgBox "comment added"
    End If
Else
    MsgBox "There is not a Tour or Date on this Row."
    GoTo hell
    End If
    Else
    MsgBox "Select the cell with the Aircraft that you would like to create a Comment for, and try again."
End If

    Exit Sub
hell:
    'MsgBox "No Comment"
End Sub

所以基本上sheet2有需要添加到sheet1的注释信息。需要在sheet1上注释的单元格是未知的，必须找到它。因此，我在sheet1上找到与sheet2的日期匹配的列，并在与id匹配的行中找到相同的列。现在行和列相交时，sheet1上的单元格需要添加注释。然后，我从sheet2上的活动行编译评论，并做一些检查，以确保评论不存在。希望对大家有所帮助。

如果有人对我的代码如何设置或我可以做的任何改进有任何输入，我将感激反馈。谢谢。