Fatal编程技术网
  • vba/
  • VBA在注释框中保留更改

VBA在注释框中保留更改

vba excel

VBA在注释框中保留更改,vba,excel,Vba,Excel,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

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
原始答案如下：

但我正试图改变它，在评论框中保留最多5个历史更改，并且在进行新更改时，删除最旧的更改。我想做以下的手术：

'计算：（时间的双点），当大于5时，比较更改的日期和时间，删除最旧的更改，并记录新的更改（第6个）

有谁有更好的主意吗？我对VBA和编程都是新手。

首先，这是一个非常酷的想法：）

理想情况下，您将拥有一个最多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
希望这能有所帮助，如果有什么不清楚或您有其他问题，请告诉我。

我会这样做-我假设工作表事件足够琐碎，因此我正在制作一个子例程，从单元格中获取值并将其添加到注释中，因为这是重要的部分

允许的注释数是一个常量，定义为
注释数
。除沫器也是一个常数，
DELIM=“>>”

输入范围中的值后，子对象将获取该值并使用循环将其添加到注释中。我正在单元格中“输入”文本
Test 00N
。与其解释，不如看：

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



如您所见，只取最后5个值。如果我们将
评论数
更改为12，我们将得到以下结果：

:

这是代码的样子：


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


-


如果您开始在单元格中输入“>>”之类的值，此代码将被破坏，但这可能是您可以接受的。因此，这是我的工作版本：


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



Private子工作表\u更改（ByVal目标作为范围）
如果范围（“A”&Target.Row）.Value=”“，则转到
如果Target.Row为0，则StillTwoDoubleDoots=True
安装时执行（CommentTemp，“：”）>0
如果InStr（CommentTemp，“：”）>LongestName，则LongestName=InStr（CommentTemp，“：”））
CommentTemp=右侧（CommentTemp，Len（CommentTemp）-InStr（CommentTemp，“：”））
环
count=CountChr（CommentString，“：”）
如果计数>=5，则
LastDoubleDotPosition=Len（CommentString）-Len（CommentTemp）-1
CommentString=Left（CommentString，LastDoubleDotPosition-13）
如果结束
'插入注释
作为字符串的模糊最终注释
FinalComment=Format（Now（），“DD.MM.YYYY hh:MM”）和“&”“by”&”“Application.UserName&vbCrLf&CommentString”新成员和旧注释
范围（“B”和Target.Row）。添加注释最终注释
设置CommentBox=Range（“B”和Target.Row）。注释
LongestName=LongestName*5
如果LongestName<150，则LongestName=150
带评论框
.Shape.Height=60
.Shape.Width=LongestName
以
恩德Sub：
Application.EnableEvents=True
端接头
“柜台
公共函数CountChr（表达式为字符串，字符为字符串）的长度为
结果很长
将部分（）设置为字符串
零件=拆分（表达式、字符）
结果=UBound（第1部分）
如果（结果=-1），则
结果=0
如果结束
CountChr=结果
端函数



要求已更改，我在评论框中只保留更改的时间和日期以及用户名。
一个用于存储以前评论的电子表格。我对所有帮助我的答案进行了投票，这就是我将链接放在原始问题上的原因。但是谢谢你的建议。谢谢你的建议，把评论分开，肯定比只数“：”.Hi@vityta要好。再次感谢您的建议，我将首先尝试构建我自己的函数，您在灵感方面帮助了我很多。你是一座金矿。

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