2013-02-27 94 views
2

所以我找到並修改了一個適合我需求的宏,但是有一個限制。我正在構建一個宏查找特定診斷代碼和程序代碼的醫療支付數據。在我目前正在研究的項目中,只有14個診斷代碼,因此我可以直接將其放入VBA中。但是,有超過800個程序代碼是我無法裝入VBA的。 我能夠做一個單獨的VBA步驟來引入一個包含這些數據的表格,但是我似乎無法將它設置爲在桌子上搜索。但是,話雖如此,運行這種VBA搜索如此多的項目的最佳方式是什麼?Excel VBA搜索瓦特/大陣列

Sub PROCEDURE_1_search() 
Dim FirstAddress As String 
Dim MySearch As Variant 
Dim myColor As Variant 
Dim Rng As range 
Dim I As Long 

MySearch = Array("412", "4100", "4101", "4102", "4103",...) <-- have over 800 

    With Sheets("All Claims by Date of Service").range("G5:G55000") 
    For I = LBound(MySearch) To UBound(MySearch) 
     Set Rng = .Find(What:=MySearch(I), _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlValues, _ 
         LookAt:=xlPart, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 
     If Not Rng Is Nothing Then 
      FirstAddress = Rng.Address 
      Do 
       With ActiveSheet.range("B" & Rng.Row & ":O" & Rng.Row) 
        .Font.ColorIndex = 1 
        .Interior.ColorIndex = 4 
       End With 
       Set Rng = .FindNext(Rng) 
      Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress 
     End If 
    Next I 
End With 
End Sub 

我可能會想出一個答案,而不是提出正確的問題。請讓我知道是否有任何我可以澄清,並提前感謝您的任何幫助。

-Ryan

+2

所以現在你們遇到了什麼問題?你的代碼是否工作,但比你想要的要慢,或者你得到了哪些特定的錯誤? – 2013-02-27 00:28:43

+0

你的問題不是數組的大小,800是好的,它是大量的行(55000),你正在執行一次搜索800次。 – Sam 2013-02-27 03:21:02

+0

事實上,它更像是成爲問題的結果總量而不是面積。您正在爲每個匹配的800個代碼格式化每個匹配的代碼 - 因此對於每個代碼發現10個代碼,您將單獨格式化8000行。有些行可能會重疊。我會使用a)'Union'並在最後做一種格式b)在你的範圍內使用自動過濾器 – brettdj 2013-02-27 03:46:34

回答

2

對於搜索一個數組,我會建議您將數據轉儲到一個變量數組,而不是通過迭代範圍。這樣可以減少代碼和表單上的流量 - 特別是格式化。格式是反正昂貴,在你的情況下,它似乎花費你一個月球..

所以這裏是如何通過步驟:(不是代碼 - if you need a code take a look at these samples.)。

  1. 移調數據到一個變量數組
  2. 搜索您在VBA代碼願望
  3. 轉儲中的位置(範圍)databack
  4. 格式(範圍)
1

在你例如,您可以使用AutoFilter這樣來突出顯示從B列到O列的行,其中G在單個鏡頭中落在4101-4103之間(即四個標準匹配單個條件)。稍微適應一下就是將這個代碼塊稱爲不同的標準,例如標準412等。

Sub Smaller() 
Dim rng1 As Range 
Set rng1 = Sheets("All Claims by Date of Service").Range("$G$5:$G$55000") 
With rng1 
    .AutoFilter Field:=1, Criteria1:=">=4100", Operator:=xlAnd, Criteria2:="<=4103" 
     .Offset(0, -6).Resize(rng1.Rows.Count, 14).Font.ColorIndex = 1 
     .Offset(0, -6).Resize(rng1.Rows.Count, 14).Interior.ColorIndex = 4 
End With 
Sheets(rng1.Parent.Name).AutoFilterMode = False 
End Sub