Excel公式和宏不兼容？

时间：2015-11-04 23:09:04

标签： excel vba excel-vba

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

我遇到的问题是，当加载项（切换）中的公式处于活动状态时，在文件中运行宏将导致Excel超时并冻结。即使安装了宏，公式本身也可以工作，并且当公司标识公式未激活时，宏会成功运行。我曾经以为这是一个内存问题，但我在Excel 2016 64 Bit中运行它，我认为它只受物理内存（塔上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

Address Splitter宏是：

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

我尝试在论坛和网上查找解决方案，但我找不到任何东西。它似乎不是一个内存限制的东西，虽然我意识到它可以。如果我还能提供其他任何帮助以解决此问题，请告诉我。

由于

2 个答案:

答案 0 :(得分：0)

您可以通过将目标名称移动到数组并循环来降低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的短路评估，它就会立即返回，因此您的原始版本每次都会评估每个子句。

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

答案 1 :(得分：0)

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

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

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

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

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

相关问题
最新问题