Excel 公式和宏不兼容？答案

【问题标题】：Excel Formula and Macro not compatible?Excel 公式和宏不兼容？
【发布时间】：2015-11-09 16:14:18
【问题描述】：

我正在努力创建一些新的宏和公式，以帮助我们在办公室的工作自动化。我们处理了很多公司信息，所以我写的公式是一个公司识别过程，将列表中的所有公司标记为“NAV”。我们使用的宏采用组合地址单元并将其扩展为多列（Ad1、Ad2、City、State、Zip）。两者都可以非常方便地解决我们必须处理的一些繁忙工作。

我遇到的问题是，当公式在加载项中处于活动状态（切换）时，在文件中运行宏会导致 Excel 超时并冻结。即使安装了宏，该公式本身也可以工作，并且当公司标识公式未激活时，宏会成功运行。我曾认为这是一个内存问题，但我在 Excel 2016 64 位中运行它，我认为它仅受物理内存（塔上 8GB）的限制。问题到底是内存问题，还是两个进程有冲突？

公司识别公式如下：

Function NAVs(Vendor)

Dim TestVendor As String
TestVendor = UCase(Vendor)

If InStr(1, TestVendor, "ADP") > 0 Or InStr(1, TestVendor, "FEDEX") > 0 Or InStr(1, TestVendor, "AFLAC") > 0 Or InStr(1, TestVendor, "AMERISOURCE") > 0 Or InStr(1, TestVendor, "ANTHEM") > 0 Or InStr(1, TestVendor, "AT&T") > 0 Or InStr(1, TestVendor, "BELL SOUTH") > 0 Or InStr(1, TestVendor, "BLUE CROSS") > 0 Or InStr(1, TestVendor, "BLUE SHIELD") > 0 Or InStr(1, TestVendor, "BLUECROSS") > 0 Or InStr(1, TestVendor, "C. H. ROBINSON") > 0 Or InStr(1, TestVendor, "CDW") > 0 Or InStr(1, TestVendor, "CH ROBINSON") > 0 Or InStr(1, TestVendor, "COMDATA") > 0 Or InStr(1, TestVendor, "COSTCO") > 0 Or InStr(1, TestVendor, "DEH SALES") > 0 Or InStr(1, TestVendor, "DELL") > 0 Or InStr(1, TestVendor, "DEPARTMENT OF TREASURY") > 0 _
    Or InStr(1, TestVendor, "ENTERGY") > 0 Or InStr(1, TestVendor, "FEDERAL EX") > 0 Or InStr(1, TestVendor, "FEDERAL EXPRESS") > 0 Or InStr(1, TestVendor, "FED EX") > 0 Or InStr(1, TestVendor, "FOOD SERVICES OF AMERICA") > 0 Or InStr(1, TestVendor, "FRITO LAY") > 0 Or InStr(1, TestVendor, "GRAINGER") > 0 Or InStr(1, TestVendor, "INTERNAL REVENUE") > 0 Or InStr(1, TestVendor, "IRS") > 0 Or InStr(1, TestVendor, "KAISER") > 0 Or InStr(1, TestVendor, "MC MASTER") > 0 Or InStr(1, TestVendor, "MCMASTER") > 0 Or InStr(1, TestVendor, "MERRITT EQUIP") > 0 Or InStr(1, TestVendor, "MICROSOFT") > 0 Or InStr(1, TestVendor, "NATIONAL GYPSUM") > 0 Or InStr(1, TestVendor, "OFFICE DEPOT") > 0 Or InStr(1, TestVendor, "OLD DOMINION") > 0 Or InStr(1, TestVendor, "OTIS ELEVATOR") > 0 Or InStr(1, TestVendor, "OWENS & MINOR") > 0 Or InStr(1, TestVendor, "OWENS AND MINOR") > 0 Or InStr(1, TestVendor, "OWENS&MINOR") > 0 _
    Or InStr(1, TestVendor, "PEPSI") > 0 Or InStr(1, TestVendor, "PERMANENTE") > 0 Or InStr(1, TestVendor, "PITNEY BOWES") > 0 Or InStr(1, TestVendor, "PSE & G") > 0 Or InStr(1, TestVendor, "PSE&G") > 0 Or InStr(1, TestVendor, "PURCHASE POWER") > 0 Or InStr(1, TestVendor, "QUILL") > 0 Or InStr(1, TestVendor, "STAPLES") > 0 Or InStr(1, TestVendor, "UNITED PARCEL SERVICE") > 0 Or InStr(1, TestVendor, "UNITED STATES TREASURY") > 0 Or InStr(1, TestVendor, "UPS") > 0 Or InStr(1, TestVendor, "US FOODS") > 0 Or InStr(1, TestVendor, "US FOODSERVICE") > 0 Or InStr(1, TestVendor, "US TREASURY") > 0 Or InStr(1, TestVendor, "VERIZON") > 0 Or InStr(1, TestVendor, "WASTE MANAGEMENT") > 0 Or InStr(1, TestVendor, "XEROX") > 0 _
Then NAVs = "NAV"

End Function

地址拆分器宏是：

Sub Splitter()

Application.EnableEvents = False
Application.ScreenUpdating = False

On Error Resume Next

SelCol = ActiveCell.Column

Blanks = 0
CurRow = 1
Header = 0
LastRow = 0

CityList = shtCity.Range("CityList").Column

Do Until Blanks = 10
    If Cells(CurRow, SelCol) = "" Then
    Blanks = Blanks + 1
    Else
    Blanks = 0

        If Header = 0 Then
        Header = CurRow
        Else
        LastRow = CurRow
        End If
    End If

CurRow = CurRow + 1
Loop

If LastRow > Header Then
CityRow = 1

    Do Until shtCity.Cells(CityRow, 1) = ""
    Range(Cells(Header + 1, SelCol), Cells(LastRow, SelCol)).Replace    What:=shtCity.Cells(CityRow, 1), Replacement:=VBA.Replace(shtCity.Cells(CityRow, 1), " ", "ZZZ"), Lookat:=xlPart
    CityRow = CityRow + 1
    Loop

Columns(SelCol).Insert
Columns(SelCol).Insert
Columns(SelCol).Insert
Columns(SelCol).Insert
Cells(Header, SelCol) = "AD1"
Cells(Header, SelCol + 1) = "AD2"
Cells(Header, SelCol + 2) = "City"
Cells(Header, SelCol + 3) = "State"
Cells(Header, SelCol + 4) = "Zip"

    For n = Header + 1 To LastRow
    TextStr = VBA.Trim(VBA.Replace(Cells(n, SelCol + 4), ",", " "))
    LastSpace = VBA.InStrRev(TextStr, " ")

        If LastSpace = 0 Then GoTo Nextn

    Cells(n, SelCol + 4) = VBA.Trim(VBA.Mid(TextStr, LastSpace))

        If VBA.IsNumeric(VBA.Replace(Cells(n, SelCol + 4), "-", "") * 1) = False Or (VBA.Len(Cells(n, SelCol + 4)) <> 5 And VBA.Len(Cells(n, SelCol + 4)) <> 10) Then
        Cells(n, SelCol + 4) = ""
            GoTo StateCodeList
        End If

    TextStr = VBA.Trim(VBA.Left(TextStr, LastSpace))
    LastSpace = VBA.InStrRev(TextStr, " ")

        If LastSpace = 0 Then GoTo Nextn
StateCodeList:
        If LastSpace <> VBA.Len(TextStr) - 2 Then GoTo NoStateCode

    Cells(n, SelCol + 3) = VBA.Right(TextStr, 2)
    TextStr = VBA.Trim(VBA.Replace(VBA.Left(TextStr, VBA.Len(TextStr) - 2), ",", " "))
    LastSpace = VBA.InStrRev(TextStr, " ")

        If LastSpace = 0 Then GoTo Nextn
NoStateCode:
    Cells(n, SelCol + 2) = VBA.Replace(VBA.Trim(VBA.Mid(TextStr, LastSpace)), "ZZZ", " ")
    TextStr = VBA.Replace(VBA.Trim(VBA.Left(TextStr, LastSpace)), ",", " ")

    SearchStr = VBA.InStr(1, TextStr, "P.O.")

        If SearchStr > 1 Then
        Cells(n, SelCol) = VBA.Trim(VBA.Left(TextStr, SearchStr - 1))
        Cells(n, SelCol + 1) = VBA.Trim(VBA.Mid(TextStr, SearchStr))
            GoTo Nextn
        End If

    SearchStr = VBA.InStr(1, VBA.UCase(TextStr), "PO BOX")

        If SearchStr > 1 Then
        Cells(n, SelCol) = VBA.Trim(VBA.Left(TextStr, SearchStr - 1))
        Cells(n, SelCol + 1) = VBA.Trim(VBA.Mid(TextStr, SearchStr))
            GoTo Nextn
        End If

    Cells(n, SelCol) = TextStr
Nextn:
    Next n

Range(Columns(SelCol), Columns(SelCol + 4)).AutoFit
End If

Exitsub:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub ShiftLeft()

Application.EnableEvents = False
Application.ScreenUpdating = False

On Error GoTo Exitsub

SelCol = ActiveCell.Column
SelRow = ActiveCell.Row

TextStr = VBA.Trim(Cells(SelRow, SelCol))
LastSpace = VBA.InStr(TextStr, " ")

If LastSpace = 0 Then
Cells(SelRow, SelCol) = ""
Cells(SelRow, SelCol - 1) = VBA.Trim(VBA.Trim(Cells(SelRow, SelCol - 1)) & " " & TextStr)
Cells(SelRow, SelCol - 1).Select
Else
Cells(SelRow, SelCol - 1) = VBA.Trim(Cells(SelRow, SelCol - 1) & " " & VBA.Trim(VBA.Left(TextStr, LastSpace - 1)))
Cells(SelRow, SelCol) = VBA.Trim(VBA.Mid(TextStr, LastSpace))
End If

Exitsub:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub ShiftRight()

Application.EnableEvents = False
Application.ScreenUpdating = False

On Error GoTo Exitsub

SelCol = ActiveCell.Column
SelRow = ActiveCell.Row

TextStr = VBA.Trim(Cells(SelRow, SelCol))
LastSpace = VBA.InStrRev(TextStr, " ")

If LastSpace = 0 Then
Cells(SelRow, SelCol) = ""
Cells(SelRow, SelCol + 1) = VBA.Trim(TextStr & " " & VBA.Trim(Cells(SelRow, SelCol + 1)))
Cells(SelRow, SelCol + 1).Select
Else
Cells(SelRow, SelCol + 1) = VBA.Trim(VBA.Trim(VBA.Mid(TextStr, LastSpace)) & " " & Cells(SelRow, SelCol + 1))
Cells(SelRow, SelCol) = VBA.Trim(VBA.Left(TextStr, LastSpace - 1))
End If

Exitsub:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

我尝试在论坛和网上寻找解决方案，但我找不到任何东西。它似乎不是内存限制的事情，尽管我意识到它可以。如果还有什么我可以提供的帮助解决这个问题，请告诉我。

谢谢

【问题讨论】：

标签： vba excel

【解决方案1】：

那么您是否在工作表上使用 NAV 功能？因为自定义用户函数是一个很大的资源消耗，如果你在很多单元上运行它，它会显着减慢，并且任何时候你做任何事情，或者任何改变，它必须重新运行所有代码乘以所有包含它的单元格。

因此，当拆分器向单元格写入任何值时，它必须再次重新计算所有 NAV。每一次。

我建议您在需要时使用表外函数，因为它看起来根本不需要重新计算，所以只需执行以下操作：

Sub DispNavs()
    Dim cel as Range
    For each cel in Range("Put a range here, in the format A1:A500")
        cel.offset(,1).value = Navs(cel.value)
    Next cel
End Sub

这会将您的函数返回的值写入您提供的范围右侧的单元格中，当然，您应该从工作表本身中删除该函数

话虽如此，您也可以在拆分器模块的开头使用application.calculation = xlManual 禁用计算，并在最后使用application.calculation = xlAutomatic 重新启用它。

让我知道这是怎么回事，或者如果出于某种原因，这两种解决方案都没有帮助。

【讨论】：

我没有考虑过使用这种方法。我正在编写另一个流程来帮助在供应商列表中标记个人姓名，这可能是一个很好的方法。谢谢安德鲁！

【解决方案2】：

您可以通过将目标名称移动到数组中并循环来降低Navs 的复杂性：

Function NAVs(Vendor)

    Dim TestVendor As String
    Dim target As Variant, i As Long
    TestVendor = UCase(Vendor)

    target = Array("ADP", "FEDEX", "AFLAC", "AMERISOURCE", "ANTHEM", "AT&T", "BELL SOUTH", "BLUE CROSS", "BLUE SHIELD", _
                   "BLUECROSS", "C. H. ROBINSON", "CDW", "CH ROBINSON", "COMDATA", "COSTCO", "DEH SALES", "DELL", _
                   "DEPARTMENT OF TREASURY", "ENTERGY", "FEDERAL EX", "FEDERAL EXPRESS", "FED EX", _
                   "FOOD SERVICES OF AMERICA", "FRITO LAY", "GRAINGER", "INTERNAL REVENUE", "IRS", "KAISER", _
                   "MC MASTER", "MCMASTER", "MERRITT EQUIP", "MICROSOFT", "NATIONAL GYPSUM", "OFFICE DEPOT", _
                   "OLD DOMINION", "OTIS ELEVATOR", "OWENS & MINOR", "OWENS AND MINOR", "OWENS&MINOR", _
                   "PEPSI", "PERMANENTE", "PITNEY BOWES", "PSE & G", "PSE&G", "PURCHASE POWER", "QUILL", _
                   "STAPLES", "UNITED PARCEL SERVICE", "UNITED STATES TREASURY", "UPS", "US FOODS", _
                   "US FOODSERVICE", "US TREASURY", "VERIZON", "WASTE MANAGEMENT", "XEROX")
    For i = 0 To UBound(target)
        If InStr(1, TestVendor, target(i)) > 0 Then
            NAVs = "NAV"
            Exit Function
        End If
    Next i

End Function

作为一个额外的好处 - 只要有匹配，它就会返回，但 VBA 不使用 Or 的短路评估，因此您的原始版本每次都会评估每个子句。

这是否会解决您的问题——我不知道。试试看。

【讨论】：

您可以使用 excel 将它们与 Text to columns 分开，使用双引号作为分隔符。然后只需找到替换 ") > 0 或 InStr(1, TestVendor, " 与空白，并使用 goto 删除空白单元格。This 是该过程之后的完整列表。
@AndrewWynn 我首先将该 Or 语句粘贴到记事本中并进行了一些替换，但是当我将结果粘贴到我手动删除的 VBA 时仍然有一些噪音。它应该是准确的，但我不想把农场押在上面。你的方法似乎比我做的更不容易出错。
@AndrewWynn 我刚刚对照你的列表检查了我的列表，发现它们都有 56 个元素，所以我删除了答案末尾的免责声明。感谢您的提示。
谢谢约翰！我很肯定必须有一种方法可以将我的 IF 语句组织成一个数组，但我无法找到如何做到这一点。当我运行早期的宏时，这最终起作用并阻止了我的 Excel 崩溃。我也会尝试实施你的解决方案，安德鲁，听起来它会在运行公式后清理我的结果
@PaulCalvert 很高兴它对你有用。请注意，如果像“Fed Ex”这样的一些供应商比其他供应商更常见，而不是在阵列中更早地移动它们可以加快速度 - 所以按照它们的常见程度对它们进行排序可能会有所帮助。另请注意，如果“Federal Express”在您的字符串中，那么“Federal Ex”也是如此——所以我没有消除一些多余的情况。