如何将带VLOOKUP公式的单元格值设为另一单元格的批注？

你的核心需求是把B1（由VLOOKUP公式生成的值）设置为A1的批注，原代码实现了基础功能，但存在几个可以优化的地方，以下是具体改进方案：

1. 避免已有批注导致的报错 #

原代码直接调用AddComment，如果A1已经存在批注，会触发运行时错误。可以先判断批注是否存在，存在则更新内容，不存在再添加：

Sub commenter()
    Dim ws As Worksheet
    Dim commentText As String
    Set ws = ThisWorkbook.Worksheets(1) ' 明确绑定当前工作簿的工作表
    
    commentText = ws.Range("B1").Value
    
    ' 处理已有批注的场景
    If Not ws.Range("A1").Comment Is Nothing Then
        ws.Range("A1").Comment.Text Text:=commentText
    Else
        ws.Range("A1").AddComment commentText
    End If
End Sub

2. 处理B1为空的情况 #

如果B1的VLOOKUP公式返回空值，添加空批注没有实际意义，可增加判断逻辑，同时支持清空A1的批注：

Sub commenter()
    Dim ws As Worksheet
    Dim commentText As String
    Set ws = ThisWorkbook.Worksheets(1)
    
    commentText = ws.Range("B1").Value
    
    ' 仅当B1非空时更新批注，为空则删除A1的批注
    If Trim(commentText) <> "" Then
        If Not ws.Range("A1").Comment Is Nothing Then
            ws.Range("A1").Comment.Text Text:=commentText
        Else
            ws.Range("A1").AddComment commentText
        End If
    Else
        If Not ws.Range("A1").Comment Is Nothing Then
            ws.Range("A1").Comment.Delete
        End If
    End If
End Sub

3. 增加错误捕获机制 #

添加错误处理，避免因工作表不存在、单元格被保护等意外情况导致代码崩溃：

Sub commenter()
    Dim ws As Worksheet
    Dim commentText As String
    
    On Error GoTo ErrorHandler ' 开启错误捕获
    
    Set ws = ThisWorkbook.Worksheets(1)
    commentText = ws.Range("B1").Value
    
    If Trim(commentText) <> "" Then
        If Not ws.Range("A1").Comment Is Nothing Then
            ws.Range("A1").Comment.Text Text:=commentText
        Else
            ws.Range("A1").AddComment commentText
        End If
    Else
        If Not ws.Range("A1").Comment Is Nothing Then
            ws.Range("A1").Comment.Delete
        End If
    End If
    
    Exit Sub ' 正常执行完毕，跳过错误处理段
ErrorHandler:
    MsgBox "运行出错：" & Err.Description, vbExclamation
End Sub

4. 扩展为批量处理（可选） #

如果需要对整列数据（A列对应B列）批量设置批注，可修改代码实现循环处理：

Sub BatchCommenter()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim commentText As String
    
    Set ws = ThisWorkbook.Worksheets(1)
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row ' 获取B列最后一行数据行号
    
    For i = 1 To lastRow
        commentText = ws.Range("B" & i).Value
        
        If Trim(commentText) <> "" Then
            If Not ws.Range("A" & i).Comment Is Nothing Then
                ws.Range("A" & i).Comment.Text Text:=commentText
            Else
                ws.Range("A" & i).AddComment commentText
            End If
        Else
            If Not ws.Range("A" & i).Comment Is Nothing Then
                ws.Range("A" & i).Comment.Delete
            End If
        End If
    Next i
End Sub

内容的提问来源于stack exchange，提问作者balazshorvath1229