工作表更改事件仅在select区域时有效 – 如何调整为自动更新
这个子模块的组合
Sub hithere3() Dim Rng As Range Dim Unique As Boolean For Each Rng In Worksheets("Sheet8").Range("FS3:FS30") 'for each cell in your B1 to B30 range, sheet1 Unique = True 'we'll assume it's unique Lastunique = Worksheets("TRADES").Range("C:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row For i = 3 To Lastunique 'for each cell in the unique ID cache If Rng.Value = Worksheets("TRADES").Cells(i, 3).Value Then 'we check if it is equal Unique = False 'if yes, it is not unique End If Next If Unique Then Worksheets("TRADES").Cells(Lastunique + 1, 3) = Rng 'adds if it is unique Next End Sub 循环检查工作表中的更改事件
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("FS3:FS33")) Is Nothing Then 'Do nothing ' Else Call hithere3 End If End Sub
除了只在FS3：FS33中select其中一个单元时才更新
任何人都可以build议如何克服？
也许从下面的工作变更范围selecttypes？
Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range, Dn As Range, n As Long Dim RngB As Range, RngC As Range If Target.Column = 2 And Target.Count = 1 And Target.Row > 1 Then With CreateObject("scripting.dictionary") .CompareMode = vbTextCompare Set RngB = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp)) Set RngC = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)) ray = Array(RngB, RngC) For n = 0 To 1 For Each Dn In ray(n) If Not Dn.Address(0, 0) = "C1" And Not Dn.Value = "" Then .Item(Dn.Value) = Empty End If Next Dn Next n Range("C2").Resize(.Count) = Application.Transpose(.Keys) End With End If
使用工作表计算事件或工作表更改事件：
- 使用计算范围是否包含公式
- 如果手动更改范围中的单元格，请使用更改
If Intersect(Target, Range("FS3:FS33")) Is Nothing是罪魁祸首。 您必须将Range("FS3:FS33")更改为您想要影响此更改的范围。
Private Sub Worksheet_Change(ByVal Target As Range) '<<delete the "Selection" from the name of event If Intersect(Target, Range("FS3:FS33")) Is Nothing Then 'Do nothing ' Else Call hithere3 End If End Sub
最后搞清楚了，下面的代码工作：
Private Sub Worksheet_calculate() If Range("FS3:FS33") Is Nothing Then 'Do nothing' Else Call hithere3 End If End Sub