从用户窗体更新后，如何使用单元格上的注释框跟踪更改？

Question

我正在尝试编写一个 VBA 宏来跟踪单独工作表中工作表的更改（显示更改历史记录），方法是在用户搜索和更新数据时自动在单元格上显示带有某种颜色的注释框用户表单。

以下代码用于搜索和更新：

''此代码用于更新用户表单中的数据''

Private Sub cmdupdate_Click()
If Me.TextBox1.Value = "" Then
MsgBox "SL No Can Not be Blank!!!", vbExclamation, "SL No"
Exit Sub
End If
SLNo = Me.TextBox1.Value
Sheets("Sheet1").Select
Dim rowselect As Double
rowselect = Me.TextBox1.Value
rowselect = rowselect + 1
Rows(rowselect).Select
Cells(rowselect, 2) = Me.TextBox2.Value
Cells(rowselect, 3) = Me.TextBox3.Value
Cells(rowselect, 4) = Me.TextBox4.Value
Cells(rowselect, 5) = Me.TextBox5.Value
Cells(rowselect, 6) = Me.TextBox6.Value

End Sub

''以下代码用于从excel表中搜索并显示在用户表单中''

Private Sub cmdSearch_Click()
Do
        DoEvents
        row_number = row_number + 1
        item_in_review = Sheets("Sheet1").Range("A" & row_number)
        If item_in_review = TextBox1.Text Then
            TextBox2.Text = Sheets("Sheet1").Range("B" & row_number)
            TextBox3.Text = Sheets("Sheet1").Range("C" & row_number)
            TextBox4.Text = Sheets("Sheet1").Range("D" & row_number)
            TextBox5.Text = Sheets("Sheet1").Range("F" & row_number)
            TextBox6.Text = Sheets("Sheet1").Range("E" & row_number)
        End If
    Loop Until item_in_review = ""
End Sub

现在我尝试在使用用户表单更新 excel 工作表后添加以下代码以进行跟踪更改，但在“Target.Comment.Text Text:=OldVal”这一行中出现错误，无法获得完成我的解决方案任务。

Sub Worksheet_Change(ByVal Target As Range)
Dim X As Integer
    Set Wb = ThisWorkbook
        ShtName = "Edits Log"
    If Target.Cells.Count > 1 Then Exit Sub
    X = EndRow + 1
    Wb.Sheets(ShtName).Range("A" & X).Value = ActiveSheet.Name
    Wb.Sheets(ShtName).Range("B" & X).Value = Target.Address
    Wb.Sheets(ShtName).Range("C" & X).Value = OldVal
    Wb.Sheets(ShtName).Range("D" & X).Value = Target.Value
    Wb.Sheets(ShtName).Range("E" & X).Value = Now()
    Wb.Sheets(ShtName).Range("F" & X).Value = Environ("username")
    Target.Interior.ColorIndex = 6
    On Error Resume Next
    Target.AddComment
    On Error GoTo 0
    Target.Comment.Visible = False
    Target.Comment.Text Text:=OldVal
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    OldVal = Target.Value
End Sub

Answer 1

从 cmets 抛出错误是因为 oldVal 是 Empty。当先前的空白单元格被更改时，Selection Change 会触发，并且由于单元格中没有先前的值，oldVal 将是 Empty。

Worksheet Change 代码需要处理这种可能性，以及 Target 包含错误的可能性 - 例如＃价值！或#N/A。

去掉写入“编辑日志”选项卡的部分，您的Worksheet Change 可能类似于以下代码：

Option Explicit

Public oldVal 'should be a Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    oldVal = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub

    Target.Interior.ColorIndex = 6

    On Error Resume Next
    Target.AddComment
    On Error GoTo 0

    With Target.Comment
        .Visible = False
        If Not IsEmpty(oldVal) And Not IsError(oldVal) Then
            .Text CStr(oldVal)
        Else
            .Text "Previously blank or an error"
        End If
    End With
End Sub