具有大型阵列的Excel VBA搜索

时间:2013-02-27 00:14:48

标签: arrays performance excel vba search

所以我找到并修改了一个符合我需要的宏,但是有一个限制。我正在构建一个宏来搜索医疗支付数据,以获取特定的诊断代码和程序代码。在我目前正在进行的项目中,只有14个诊断代码,因此我可以直接将其放入VBA中。但是,有超过800个程序代码,我无法在VBA中使用。 我能够做一个单独的VBA步骤来引入一个包含这些数据的表,但我似乎无法设置它来搜索表。但话虽如此,运行此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 个答案:

答案 0 :(得分:2)

为了搜索数组,我建议您将数据转储到变量数组中,而不是遍历范围。这样就减少了代码和工作表上的重新流量 - 特别是格式化。格式化无论如何都很昂贵,在你的情况下它似乎花了你一个月亮..

以下是步骤:(不是代码 - if you need a code take a look at these samples.)。

  1. 将数据转置为变量数组
  2. 按照您的意愿搜索VBA代码
  3. 将数据包转储到位置(范围)
  4. 格式(范围)

答案 1 :(得分:1)

在您的示例中,您可以像这样使用AutoFilter来突出显示B到O列中的行,其中G在单个镜头中落在4101-4103之间(即四个条件匹配单个条件)。一个小的改编是将这个代码块称为不同的标准,例如Standaline 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