1. 首頁
  2. 問答
  3. Excel公式和宏不兼容？

Excel公式和宏不兼容？

2015-11-04 40 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

相關問題

 相關問題