Excel - 自动化 VBA，无需每次都运行答案

【问题标题】：Excel - Automate VBA without have to run everytimeExcel - 自动化 VBA，无需每次都运行
【发布时间】：2016-12-21 02:38:24
【问题描述】：

我想自动化我的 VBA，而不必每次有人更改单元格时都运行 VBA。我尝试使用 Worksheet_Change(ByRef Target As Range) 但出现编译器错误。下面是我没有使用 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

【问题讨论】：

你看到了什么错误？
我认为您正在使用 B 列中人员姓名的电子邮件地址更新 C 列（其中 B 列中的每个单元格都有多个人，以逗号分隔）。因此，您需要 (1) 当 Sheet2!B 中的值发生变化时更新单行的 Sheet2!C 和 (2) 当 Email!B:C 中的任何单元格发生变化时更新 Sheet2!C:C。那是对的吗？您的 Worksheet_Change 事件代码是什么不起作用，它在哪个工作表中？
我收到此错误“编译错误：过程声明与具有相同名称的事件或过程的描述不匹配”@dgorti
这段代码工作正常，但我只想自动化它。我只是将 getEmails() 更改为 Private Sub Worksheet_Change(ByRef Target As Range)
您需要将Worksheet_Change 子代码放入Sheet2 代码模块中，是吗？

标签： vba excel

【解决方案1】：

Private Sub Worksheet_Change(ByRef Target As Range)

应该是：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  '<-- ByVal

这应该是 sub 的原型，应该放在 Sheet2 代码模块中（就像你已经做的那样）。

附录

这是您的 sub 的重构版本，应该更快且更易于维护。它仅在 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

【讨论】：

我已经更改为 Private Sub Worksheet_SelectionChange(ByVal Target As Range) 并且没有错误，但我无法更新单元格，它挂起了工作簿
它起作用了，但它使床单冻结了几分钟。总之谢谢
@gpsrosak 这是意料之中的，因为您正在为单个更改进行所有更新。您的潜艇有很大的优化和加速空间。至少我们让它在 atm 工作。
@gpsrosak 请尝试修改后的代码，应该会更快。

【解决方案2】：

确保您的 Worksheet_Change 事件位于您正在使用的工作表的后面，而不是在模块中。右键单击工作表并选择查看代码。将代码放入打开的窗口中。

看看这个。

http://www.excel-easy.com/vba/events.html

【讨论】：