如何让撤消与VBA代码共存

wudechun

为了方便在表格中看到所选单元格，我在以下事件中设置了一个增加底色的功能：Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells.Interior.ColorIndex = xlNone
    Target.Interior.ColorIndex = 27
End Sub


但由于这个宏运行的很频繁，导致前台的工作表中进行了操作后会无法行撤消操作。
请问各位前辈有没有好的解决方法？

hhjjpp

那就别用这事件！

wudechun

设计了一个可以简单记录值修改的过程

1. '高亮所选行，辅助确定部门----------------------------
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3.     Dim i As Long
   
4.     Dim LLogTolNum As Long
   
5.     On Error Resume Next
   
6. 
   
7. 
   
8.     If Sheets("参数设置").Cells(22, "B") = "开启" And Target.Value <> "" Then
   
9.         If 上次地址 <> Target And 上次值 <> Target.Value Then
   
10. 
    
11.             LLogTolNum = Sheets("log(测试)").[a65536].End(xlUp).Row
    
12. 
    
13.             With Sheets("Log(测试)")
    
14.                 .Cells(LLogTolNum + 1, "A") = LLogTolNum
    
15.                 .Cells(LLogTolNum + 1, "B") = Target.Address
    
16.                 .Cells(LLogTolNum + 1, "C") = Target.Value
    
17.                 .Cells(LLogTolNum + 1, "E") = Cells(1, Target.Column)
    
18.             End With
    
19.         End If
    
20.     End If
    
21. 
    
22.     If Sheets("参数设置").Cells(21, "B") = "开启" Then
    
23. 
    
24.         i = Target.Row
    
25.         If 上一个着色行 <> 0 Then
    
26.             Range("E" & 上一个着色行 & ":N" & 上一个着色行).Interior.ColorIndex = xlNone
    
27.         End If
    
28.         If i <> 1 Then
    
29.             Range("E" & i & ":N" & i).Interior.ColorIndex = 28
    
30.             上一个着色行 = i
    
31.             上次地址 = Target
    
32.             上次值 = Target.Value
    
33.         End If
    
34.     End If
    
35. End Sub
    
36. Sub test_撤消()
    
37.     Dim LLogTolNum As Long
    
38.     Dim i As Long
    
39.     Dim address As String
    
40.     Dim 值
    
41. 
    
42.     LLogTolNum = Sheets("log(测试)").[a65536].End(xlUp).Row
    
43.     For i = LLogTolNum To 2 Step -1
    
44.         If Sheets("Log(测试)").Cells(i, "D") = "*" Then
    
45.             address = Sheets("Log(测试)").Cells(i, "B")
    
46.             值 = Sheets("Log(测试)").Cells(i, "C")
    
47. 
    
48.             With Sheets("分解明细")
    
49.                 .Range(address) = 值
    
50.             End With
    
51.         End If
    
52.     Next
    
53.     'Sheets("Log(测试)").Range("a2:c" & LLogTolNum).Clear
    
54.     Sheets("Log(测试)").Range("d2:d" & LLogTolNum).Clear
    
55. End Sub
    

复制代码