Question

甚至不确定如何提出这个问题。我有一个excel维护计划（sheet1）。使用A列中的设备进行设置（冻结），并在第1行中设置日期。当我对计划进行维护操作时，我经常需要添加注释。
表二有维护行动上升。一些列是：日期，维护行动和工人数量。表2中的一些列具有我在sheet1（时间表）上手动输入的信息作为注释，工作者数量是我总是添加到注释中的数量。如果我不必输入这些内容，那将是一个很大的节省时间。我想创造什么： sheet2具有maint操作发生的日期，sheet1在顶部有日期。我想让一个宏在sheet1中找到与sheet2中的日期匹配的日期列，然后在sheet1中找到与该maint操作的sheet2中的equipmentID匹配的行。然后注释可以编译为sheet2中的行信息的字符串，并写为sheet1上的注释。

有点像这样。单击sheet2上的按钮。它在sheet1上找到与date列和equipmentID行对齐的单元格。编译来自sheet2单元格b3，b4，b5的注释。在sheet1中找到的单元格中插入注释。然后循环播放sheet2上的每个maint动作。应该在插入新单元格之前清除找到的单元格的所有注释。

有人对此有任何想法吗？或者指点我正确的方向？谢谢你的帮助。

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上的活动行编译注释并进行一些检查以确保注释不存在。希望这有助于某人。

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

excel vba使用关键字在单元格上插入评论

1 个答案: