excel vba使用关键字在单元格上插入注释

甚至不知道该怎么问这个问题。我有一份excel维护计划表（表1）。设置A列设备（冻结）和第1行日期。当我将维护操作列入计划时，我通常需要添加注释。
第二张表显示了维护操作。其中有几列是：日期、维护操作和工人数量。工作表2中的某些列包含我在工作表1（明细表）中手动输入的信息作为注释，我总是将工作人数添加到注释中。如果我不必把这些都打进去的话，那将大大节省时间。 我想创造的是： 表2有执行维护操作的日期，表1顶部有日期。我希望使用宏在sheet1中查找与sheet2中的日期匹配的日期列，然后在sheet1中查找与sheet2中的设备ID匹配的行，以便执行该维护操作。然后，可以将注释编译为sheet2中该行信息的字符串，并将其作为注释写入sheet1

有点像这样。单击第2页上的按钮。它在sheet1上找到与date列和equipmentID行对齐的单元格。从表2单元格b3、b4、b5中编译注释。在sheet1中找到的单元格中插入注释。然后在表2上循环执行每个维护操作。 在插入新单元格之前，可能应该清除已找到单元格的所有注释

---

有人对此有什么想法吗？或者给我指出正确的方向？谢谢你的帮助。

谢谢你的帮助！！！在别处找到了一些答案。如果有人感兴趣，下面是我的想法

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

Sub-setComment4Tour（）
错误上地狱
变暗变暗范围
Dim id，AC作为字符串
将搜索范围变暗为范围
调暗wcol作为范围
Dim fdate作为日期
变暗fcell As范围
如果不相交（ActiveCell，范围（“aa:aa”））为空，则“检查其他图纸范围中的当前图纸ActiveCell值”
如果范围（“A”&ActiveCell.row）”和范围（“C”&ActiveCell.row）”，则“检查当前工作表列A&C中的值
id=ActiveCell.Value
fdate=范围（“C”和ActiveCell.row）.值
'查找行参考
设置wrow=工作表（“每周”）。范围（“a4:a13”）。查找（id，lookat:=xlPart）
如果没有，那就什么都不是了
如果结束
'查找列引用
设置搜索范围=工作表（“每周”）。范围（“3:3”）
设置wcol=SearchRange.Find（fdate，LookIn:=xlValues，lookat:=xlWhole）
设置fcell=Worksheets（“WEEKLY”）.Cells（wrow.row，wcol.Column）组合行和列以获得目标单元格
如果不是InStr（UCase（fcell），“TOUR”）0，则
mb1=MsgBox（“周刊没有为“&id&“&Chr（10）”和“是否要为“&id&”创建信息注释？”，vbYesNo，“未找到旅行！”）
如果mb1=vbYes，则
转到updateComment“下一步继续”
其他的
下地狱
如果结束
如果结束
'MsgBox“cell”和fcell.Address
更新建议：
'基于activecell行中当前工作表信息的新注释
newcmnt=Range（“A”和ActiveCell.row）。Value&Chr（10）和Range（“D”和ActiveCell.row）。Value和“-”和Range（“E”和ActiveCell.row）。Value&Chr（10）和“成人”和Range（“F”和ActiveCell.row）。Value&Chr（10）和“儿童”和Range（“G”和ActiveCell.row）。Value
如果fcell.Comment什么都不是，那么
'Set ctext=Worksheets（“WEEKLY”）.Cells（wrow.row，wcol.Column）。注释
'fcell.Comment.Text:=atext
fcell.AddComment文本：=newcmnt
fcell.Comment.Shape.TextFrame.AutoSize=True
MsgBox“添加注释”
ElseIf InStr（fcell.Comment.Text，Range（“A”&ActiveCell.row）.Value）0然后“检查注释标题是否已存在”
MsgBox“Tour”和Range（“A”&ActiveCell.row）。Value&“的信息注释已存在于周刊上。”
Else’用附加注释结束当前注释
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）&Chr（10）&Range（“F”&ActiveCell.row）。Value&Chr（10）&Children”&Range（“G”&ActiveCell.row）。Value
fcell.Comment.Text文本：=newcmnt
fcell.Comment.Shape.TextFrame.AutoSize=True
MsgBox“添加注释”
如果结束
其他的
MsgBox“此行中没有巡演或日期。”
下地狱
如果结束
其他的
MsgBox“选择要为其创建注释的飞机所在的单元格，然后重试。”
如果结束
出口接头
地狱：
'MsgBox“无评论”
端接头

因此，sheet2基本上有需要添加到sheet1的注释信息。sheet1上需要注释的单元格未知，必须找到该单元格。因此，我在sheet1上找到了与sheet2中的日期匹配的列，在与id匹配的行中找到了相同的列。现在，通过行和列的相交，我在sheet1上找到了需要添加注释的单元格。然后，我从sheet2上的活动行编译注释，并进行一些检查以确保注释不存在。希望这对别人有帮助

---

如果有人对我的代码设置或我能做的任何改进有任何意见，我将不胜感激。谢谢。

到底是哪一部分给您带来了问题？在表2中的行上循环？在sheet1上找到单元格？您可以尝试使用

Find（）

或

Match（）

执行定位。如果遇到问题，请用代码发回。此问题似乎与主题无关，因为它不包含特定问题，也不包含任何帮助解决问题的代码。我没有任何代码。我希望能得到一些帮助。是的，我需要关于循环和查找单元格代码的帮助。