1. 首页
  2. 问答
  3. Excel公式和宏不兼容？

Excel公式和宏不兼容？

2015-11-04 163 views
0

我正在创建一些新的宏和公式来帮助自动化我们在办公室的工作。我们处理了很多公司信息，因此我写的公式是一个公司识别过程，它将列表中的所有公司都标记为“NAV”。我们正在使用的宏需要一个组合的地址单元，并将其扩展到多个列（Ad1，Ad2，City，State，Zip）。这两种方法在处理我们必须处理的一些繁忙工作时非常方便。Excel公式和宏不兼容？

我一直在遇到的问题是，当公式在加载项（切换）中处于活动状态时，在文件中运行宏将导致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

的地址分配器宏：

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

我试着在网上找了在论坛上，并解决这一点，但我无法找到任何东西。它似乎并不是一个限制内存的东西，尽管我意识到它可以。请让我知道，如果有什么我可以提供帮助解决这个问题。

感谢

来源

2015-11-04 PaulCalvert

回答

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的短路评估，因此您的原始版本每次都会评估每个子句。

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

来源

2015-11-04 23:31:17

+1

您可以使用excel将这些文本与文本分隔列，并使用双引号作为分隔符。然后找到替换“）> 0或InStr（1，TestVendor，”空白，并使用goto删除空白单元格。[This]（http://pastebin.com/GfHUdemn）是该过程后的完整列表。 –

+0

@AndrewWynn我开始把这个Or语句粘贴到记事本中，做了一些替换，但是当我把结果粘贴到我手动删除的VBA中时，仍然有一些噪音，它应该是准确的，但我不想打赌农场。方法似乎不像我所做的那样容易出错ERROR： –

+0

@AndrewWynn我刚刚检查了我的清单，看到它们都有56个元素，所以我删除了我在答案结尾处的免责声明，谢谢你的提示。 –

0

那么你在工作表上使用NAVs函数吗？因为自定义用户函数是一个巨大的资源，如果你在很多单元上运行它，它会显着减慢速度，并且每当你做任何事情或任何改变时，它都必须重新运行所有代码乘以全部包含它的细胞。

所以当分离器写入任何值给单元格时，它必须重新计算所有的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重新启用它。

让我知道这是怎么回事，或者如果由于某种原因，这两种解决方案都无济于事。

来源

2015-11-04 23:46:40

+0

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

相关问题

 相关问题