Vba Excel公式和宏不兼容？

我正致力于创建一些新的宏和公式，以帮助实现办公室工作的自动化。我们处理很多公司信息，所以我写的公式是一个公司识别过程，将列表中的所有公司标记为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

我试着在论坛和网上寻找解决方案，但什么都找不到。虽然我意识到这是可能的，但它似乎并不是一种记忆限制。请让我知道，如果有什么我可以提供，以帮助解决这个问题

---

谢谢

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

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不会使用短路求值，或者您的原始版本每次都会求值每个子句

---

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

那么您是否在使用工作表上的导航功能？因为自定义用户函数占用大量资源，如果您在许多单元格上运行此函数，它将大大降低速度，并且无论何时您执行任何操作或任何更改，它都必须重新运行所有代码乘以包含它的所有单元格

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

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

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重新启用它

---

让我知道这是怎么回事，或者如果出于某种原因，这两种解决方案都不起作用。

您可以使用excel以文本到列的方式将它们分开，使用双引号作为分隔符。然后用空格查找replace>0或InStr1，TestVendor，并使用goto删除空白单元格。是该过程之后的完整列表。@Andrewynn我开始将该Or语句粘贴到记事本中并进行一些替换，但在将结果粘贴到VBA（手动删除）中时仍有一些杂音。它应该是准确的，但我不想把赌注押在它上面。你的方法似乎不像我那样容易出错。@Andrewynn我刚刚对照你的列表检查了一下，发现它们都有56个元素，所以我删除了我在回答末尾的免责声明。谢谢你的提示。谢谢你，约翰！我确信必须有一种方法将IF语句组织成一个数组，但我找不到如何做到这一点。当我运行之前的宏时，它停止工作并阻止Excel崩溃。我也会尝试实现您的解决方案，Andrew，听起来它会在运行formula@PaulCalvert很高兴它对你有用。请注意，如果像Fed Ex这样的一些供应商比其他供应商更常见，那么在阵列中较早地移动它们可能会加快速度，因此根据它们的常见程度对它们进行排序可能会有所帮助。还要注意的是，如果联邦快递在你的字符串中，那么联邦快递也在你的字符串中，所以有一些多余的情况我没有排除。我没有考虑使用这种方法。我正在编写另一个流程来帮助在供应商列表中标记个人姓名，这可能是一个很好的方法。谢谢安德鲁！