Question

Wright现在，我正在使用此功能保留评论中来自单元格的数据的最后更改：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    val_before = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then
        MsgBox Target.Count & " cells were changed!"
        Exit Sub
    End If

    If Target.Comment Is Nothing Then
        Target.AddComment
        existingcomment = ""
    Else
        existingcomment = Target.Comment.Text & vbLf & vbLf
    End If

    Target.Comment.Text Text:=Format(Now(), "DD.MM.YYYY hh:mm") & ":" & vbLf & Environ("UserName") & _
        " changed " & val_before & Target.Address & " from:" & vbLf & """" & val_before & _
        """" & vbLf & "to:" & vbLf & """" & Target.Value & """"

End Sub

原始回答：FIDDLE >

但我正在尝试更改它，在评论框中最多保留5个历史记录更改，并在进行新的更改时删除最旧的更改。我正在考虑做以下操作：

＆＃39;计算:(双点 - 从时间开始），当大于5时，比较更改的日期和时间，删除最旧的一个并记录新的（第6个）例如。

有没有人有更好的主意？我是VBA的新手，也是编程人员。

Answer 1

首先，这是一个非常酷的主意：）

理想情况下，您将拥有一个带有max的数组变量。 5条评论，您将使用该数组每次从头开始填充评论。但是，我可以看到这会变得有点复杂，因为你的目标是支持所有单元的通用解决方案。我假设您可能还希望在关闭工作表后保留历史记录。

数据库当然也是一个非常好的应用程序，但是我猜测建立数据库连接对你的目的来说太多了。

说完...... 你建议的方法不是那么漂亮或可靠，但我喜欢它的目的。但是，需要进行以下调整：

不计算冒号（“双点”，:)。你肯定每个评论都会有不止一个这样的评论。相反，我可能会在每个评论的末尾添加一个分界线，比如
```
Target.Comment.Text = Target.Comment.Text & vbCrLf & "--------------" & vbCrLf
```
或者你可以连续计算两个vbLf（你现在有）
而不是计算我可能会像这样分开评论：
```
comments = Split(Target.Comment.Text, vbLf & vbLf)
```
它为您提供了所有注释的数组（注释），然后您可以像这样循环：
```
For i = 0 to UBound(comments)
    ' do stuff with comments(i) here
Next
```

希望有所帮助，如果有什么不清楚或者您有其他问题，请告诉我。

Answer 2

我就是这样做的 - 我假设工作表事件足够简单，因此我正在创建一个子例程，它从一个单元格获取值并将其添加到注释中，只要这是重要的部分。

允许的注释数是一个常量，定义为NUMBER_OF_COMMENTS。 deliminator也是常量DELIM = " >> "。

一旦输入了范围中的值，则sub接受它并将其添加到带有循环的注释中。我是＆＃34;进入＆＃34;在单元格中文本Test 00N。比看起来更好看：

这是注释的样子，在单元格中插入100个值后，只保留注释中的最后5个：

如您所见，仅采用最后5个值。如果我们将NUMBER_OF_COMMENTS更改为12，那就是我们得到的结果：

：

这就是代码的样子：

Public Sub TestMeCaller()        
    Dim cnt As Long        
    For cnt = 1 To 100
        TestMe cnt
    Next cnt        
End Sub

-

Public Sub TestMe(counter As Long)

    Dim rangeWithComment        As Range
    Dim commentText             As String
    Dim commentArray            As Variant
    Dim cnt                     As Long

    Const DELIM = " >> "
    Const NUMBER_OF_COMMENTS = 12

    Set rangeWithComment = Cells(2, 2)
    rangeWithComment = "TEST 00" & counter
    commentText = DELIM & rangeWithComment
    rangeWithComment.ClearContents

    If rangeWithComment.Comment Is Nothing Then
        rangeWithComment.AddComment
        rangeWithComment.Comment.Text (commentText)
        Exit Sub
    Else
        commentArray = Split(rangeWithComment.Comment.Text, DELIM)
    End If

    For cnt = LBound(commentArray) + 1 To UBound(commentArray)        
        If cnt >= NUMBER_OF_COMMENTS Then Exit For
        commentText = commentText & _ 
                      IIf(cnt = 1, vbCrLf, vbNullString) &  DELIM & commentArray(cnt)
    Next cnt

    rangeWithComment.Comment.Text (commentText)

End Sub

如果您开始输入＆＃34;之类的值，此代码将被破坏。＆GT;＆GT; ＆＃34;在单元格中，但这是你可以忍受的东西。

Answer 3

所以，这是我的工作版本：

Private Sub Worksheet_Change(ByVal Target As Range)

   If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
   If Target.Row <= 2 Then GoTo EndeSub
   If Not Intersect(Range("C:JA"), Target) Is Nothing Then
     On Error GoTo EndeSub
     Application.EnableEvents = False
     Range("B" & Target.Row) = Now
   End If

    Application.Volatile
    Dim CommentBox As Object
    Set CommentBox = Range("B" & Target.Row).Comment
    Dim CommentString As String

    If Not CommentBox Is Nothing Then
        If CommentBox.Text <> "" Then
            CommentString = CommentBox.Text
            Range("B" & Target.Row).Comment.Delete
        End If
    Else
        CommentString = ""
    End If

    Dim CommentTemp As String
    CommentTemp = CommentString
    Dim LastDoubleDotPosition As Integer
    LastDoubleDotPosition = 0
    Dim LongestName As Integer
    LongestName = 0

    If InStr(CommentTemp, ":") > 0 Then StillTwoDoubleDots = True

    Do While InStr(CommentTemp, ":") > 0


        If InStr(CommentTemp, ":") > LongestName Then LongestName = InStr(CommentTemp, ":")
        CommentTemp = Right(CommentTemp, Len(CommentTemp) - InStr(CommentTemp, ":"))

    Loop

    count = CountChr(CommentString, ":")

    If count >= 5 Then

        LastDoubleDotPosition = Len(CommentString) - Len(CommentTemp) - 1
        CommentString = Left(CommentString, LastDoubleDotPosition - 13)

    End If

    'insert comment
    Dim FinalComment As String
    FinalComment = Format(Now(), "DD.MM.YYYY hh:mm") & " " & "by" & " " & Application.UserName & vbCrLf & CommentString 'newComment and the oldcomment
    Range("B" & Target.Row).AddComment FinalComment

    Set CommentBox = Range("B" & Target.Row).Comment

    LongestName = LongestName * 5
    If LongestName < 150 Then LongestName = 150

    With CommentBox
        .Shape.Height = 60
        .Shape.Width = LongestName
    End With


EndeSub:
    Application.EnableEvents = True

End Sub

'counter
Public Function CountChr(Expression As String, Character As String) As Long

    Dim Result As Long
    Dim Parts() As String
    Parts = Split(Expression, Character)
    Result = UBound(Parts, 1)
    If (Result = -1) Then
    Result = 0
    End If
    CountChr = Result

End Function

要求已更改，我只在评论框中保留更改的时间和日期以及用户名。

VBA会在评论框中保留更改

3 个答案: