VBA在评论框中保留更改

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 

原来的答案在这里： VBA最后更改方法

但是我试图改变它，在评论框中保留最多5个历史改变，并且当做出新的改变时，删除最旧的改变。 我正在考虑做下面的操作：

“数：（双点 – 从时间），当大于5时，比较更改的date和时间，删除最旧的一个，并logging新的一个（第六）例如。

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

Answer 1

这就是我如何做到这一点 – 我认为工作表事件是微不足道的，因此我正在做一个子例程，它从一个单元格的值，并将其添加到评论，只要这是重要的部分。

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

一旦input了范围内的值，那么子就会把它添加到注释中。 我正在input文本“ 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 

如果你开始在单元格中input像“>>”这样的代码，那么这个代码就会被破坏，但是这个代码你可能会忍受。

Answer 2

首先，这是一个非常酷的想法:)

理想情况下，你将有一个最大的数组variables。 的5条评论，你会使用该数组每次从头开始填充评论。 不过，我可以看到这会有点复杂，因为你正在寻求一个支持所有单元的通用解决scheme。 我假设你可能也希望历史在closures工作表后保留。

一个数据库当然也是这样的一个很好的应用程序，但我猜测build立一个数据库连接将是你的目的太多的工作。

话虽如此…你提出的方法并不是那么漂亮或可靠，但我喜欢它的目的。 但以下需要调整：

• 不要计算冒号（“双点”，:)。 你肯定会有不止一个这样的评论。 相反，我可能会在每个评论的末尾添加一个分界线或者其他内容，比如

   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 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 

需求被改变了，我只在评论框中保留更改的时间和date以及用户名。