单元格内容改变时用批注自动记录改动情况

快递超市

以上功能怎么用VBA实现？

liujialin0o0

工作表事件

1. Dim oldvalue
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3. If Target.Comment Is Nothing Then
   
4.     Target.AddComment Format(Now(), "mm/dd hh:mm:ss") & "  原内容： 空白    修改为： " & Target.Value
   
5. Else
   
6.     oldcomment = Target.Comment.Text
   
7.     Target.ClearComments
   
8.     Target.AddComment Format(Now(), "mm/dd hh:mm:ss") & "  原内容： " & oldvalue & "    修改为： " & Target.Value & Chr(10) & oldcomment
   
9. End If
   
10. Target.Comment.Shape.Width = 300
    
11. 'Target.Comment.Visible = True
    
12. End Sub
    
13. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
14. oldvalue = Target.Value
    
15. End Sub
    

复制代码

xrs08234

一个单元格用手工输入的方式能实现在批注里显示所修改的信息，象楼主这样用复制粘贴的方式都可以实现，特别是粘贴时居然没有把原来单元格的批注粘贴上去，确实不知该怎样写代码了，期待高人。

xrs08234

liujialin0o0 发表于 2018-12-13 15:59
工作表事件

楼主的功能是用复制粘贴的方法实现的，能写一段代码吗？

快递超市

liujialin0o0 发表于 2018-12-13 15:59
工作表事件

非常感谢你，但这个有2个问题。可以优化一下吗？
1：仅限第一个工作薄，其他工作簿无法实现
2：格式刷的时候也有一点小小的八阿哥

xrs08234

快递超市 发表于 2018-12-13 16:41
非常感谢你，但这个有2个问题。可以优化一下吗？
1：仅限第一个工作薄，其他工作簿无法实现
2：格式刷 ...

当选中多个单元格时，会报错。

xrs08234

快递超市 发表于 2018-12-13 16:41
非常感谢你，但这个有2个问题。可以优化一下吗？
1：仅限第一个工作薄，其他工作簿无法实现
2：格式刷 ...

Option Explicit
Public Y As String
Private Sub Worksheet_Change(ByVal T As Range)
  Dim X As String
  Application.EnableEvents = False
    On Error Resume Next
      If T.Value <> "" Then
        X = T.Value
       Else
        X = "空白"
     End If
        If T.Comment Is Nothing Then
            T.AddComment.Text Format(Now(), "m月d日hh:mm") & "原内容为:" & Y & "  修改为:" & X & Chr(10)
            T.Comment.Shape.TextFrame.AutoSize = True
            T.Comment.Visible = False
        Else

            T.Comment.Text T.Comment.Text & Format(Now(), "m月d日hh:mm") & "原内容为:" & Y & "  修改为:" & X & Chr(10)
        End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal T As Range)
    If T.Count > 1 Then End
     If T.Value <> "" Then
        Y = T.Value
      Else
        Y = "空白"
     End If
End Sub

YZC51

学习下
Dim oldvalue
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = "" Then Exit Sub
If Target.Comment Is Nothing Then
    Target.AddComment Format(Now(), "mm/dd hh:mm:ss") & "  原内容： 空白    修改为：" & Target.Value
Else
    oldcomment = Target.Comment.Text
    Target.ClearComments
    Target.AddComment Format(Now(), "mm/dd hh:mm:ss") & "  原内容： " & oldvalue & "   修改为：" & Target.Value & Chr(10) & oldcomment
End If
Target.Comment.Shape.Width = 300
'Target.Comment.Visible = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
oldvalue = Target.Value
End Sub

liujialin0o0

快递超市 发表于 2018-12-13 16:41
非常感谢你，但这个有2个问题。可以优化一下吗？
1：仅限第一个工作薄，其他工作簿无法实现
2：格式刷 ...

1.改为工作薄事件,2.因为触发事件的局限性,暂时没想到解决方法

1. Dim oldvalue
   
2. 
   
3. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
4. If Target.Comment Is Nothing Then
   
5.     Target.AddComment Format(Now(), "mm/dd hh:mm:ss") & "  原内容： 空白    修改为： " & Target.Value
   
6. Else
   
7.     oldcomment = Target.Comment.Text
   
8.     Target.ClearComments
   
9.     Target.AddComment Format(Now(), "mm/dd hh:mm:ss") & "  原内容： " & oldvalue & "    修改为： " & Target.Value & Chr(10) & oldcomment
   
10. End If
    
11. Target.Comment.Shape.Width = 300
    
12. End Sub
    
13. 
    
14. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    
15.     oldvalue = Target.Value
    
16. End Sub
    

复制代码

YZC51

或者
Dim oldvalue
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Len(Target) = 0 Then Exit Sub
If Target.Comment Is Nothing Then
    Target.AddComment Format(Now(), "mm/dd hh:mm:ss") & "  原内容： 空白    修改为：" & Target.Value
Else
    oldcomment = Target.Comment.Text
    Target.ClearComments
    Target.AddComment Format(Now(), "mm/dd hh:mm:ss") & "  原内容： " & oldvalue & "   修改为：" & Target.Value & Chr(10) & oldcomment
End If
Target.Comment.Shape.Width = 300
'Target.Comment.Visible = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
oldvalue = Target.Value
End Sub