Excel – 自动运行VBA，无需每次运行
我想自动化我的VBA，而不必每次有人更改单元时都运行VBA。 我尝试使用Worksheet_Change（ByRef目标作为范围），但我有编译器错误。 下面是我的代码没有使用worksheet_change事件。 这是一个共享的excel工作簿，所以我需要它在每次有人填写新的单元格或进行更改时自动执行。
Option Explicit Public Sub getEmails() Dim names As Range, findRange As Range Dim splitNames Dim selectedEmails As String, i As Long, lRow As Long Set names = Sheets("Email").Range("B1:C23") ' names range from lookup table from different worksheet With Sheets("Sheet2") ' loop column K untill last row with data (staring from row 2 >> modify where you data starts) For lRow = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row ' fill array directly from cell splitNames = Split(.Range("B" & lRow), ",") For i = 0 To UBound(splitNames) ' find the range matching the name Set findRange = names.Find(What:=Trim(splitNames(i)), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) ' if match found, get the email and store to selected emails variable If Not findRange Is Nothing Then If selectedEmails = "" Then ' first email of this row selectedEmails = findRange.Offset(0, 1).Value Else ' add a ";" to separate email addresses selectedEmails = selectedEmails & "; " & findRange.Offset(0, 1).Value End If End If Next i .Range("C" & lRow) = selectedEmails ' clrear all variables and arrays for next cycle Erase splitNames selectedEmails = "" Next lRow End With End Sub
Private Sub Worksheet_Change(ByRef Target As Range)< – ByRef：错误
它应该是：
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '<-- ByVal
这应该是子的原型，它应该放在Sheet2代码模块中（就像你已经做的那样）。
附录
这是一个重构的版本，应该更快，更易于维护。 只有当列B中的内容发生了变化时才会触发操作，并且只对已更改的部分起作用，更新列C中的邻近单元格。
Private Sub Worksheet_Change(ByVal Target As Range) Dim B As Range: Set B = Range("B2:B" & Cells(Rows.count, "B").End(xlUp).Row) Dim r As Range: Set r = Intersect(B, Target) If r Is Nothing Then Exit Sub Dim findRange As Range, selectedEmails As String, i On Error GoTo Finish Application.ScreenUpdating = False Application.EnableEvents = False Dim names As Range: Set names = Sheets("Email").Range("B1:C23") ' names range from lookup table from different worksheet Dim cel As Range For Each cel In r Dim splitNames : splitNames = Split(cel.value, ",") For Each i In splitNames ' find the range matching the name Set findRange = names.Find(What:=Trim(i), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) ' if match found, get the email and store to selected emails variable If Not findRange Is Nothing Then If selectedEmails = "" Then ' first email of this row selectedEmails = findRange.Offset(0, 1).Value Else ' add a ";" to separate email addresses selectedEmails = selectedEmails & "; " & findRange.Offset(0, 1).Value End If End If Next i cel.Offset(, 1).Value = selectedEmails selectedEmails = "" Next cel Finish: Application.ScreenUpdating = True Application.EnableEvents = True End Sub
确保您的Worksheet_Change事件在您正在使用的工作表的背后，而不是在模块中。 右键单击工作表并select查看代码。 把你的代码放到打开的窗口中。
看一下这个。