Question

我在Sheet1上有一个客户列表，在Sheet2上有原始数据。有超过40个客户群，我想知道除了为每个组设置For之外，是否有更有效的方法来处理这个问题。

客户列表位于C行。例如，A组来自C2：C25，B组是C26：C89，C组是C90：C116，依此类推。

此代码的目标是确定任何客户端组是否在Sheet2上的原始数据中（在A列中超过14k行）并显示，pref。只有一个MsgBox，他们就是。

Sub shomedawau()
Dim FindString As String
Dim Rng As Range

For Each Cell In Sheets("Sheet1").Range("C2:C32")
    FindString = Cell.Value

    If Trim(FindString) <> "" Then
        With Sheets("Sheet2").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                MsgBox "group A found"
            End If
        End With
    End If
Next

For Each Cell In Sheets("Sheet1").Range("C33")
    FindString = Cell.Value

    If Trim(FindString) <> "" Then
        With Sheets("Sheet2").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                MsgBox "group B found"
            End If
        End With
    End If
Next

End Sub

Answer 1

您的代码实际上应该很快运行。但是，如果忽略范围并开始使用数组，那么可以进行优化：

Public Sub TestMe()

    Dim r1      As Variant
    Dim r2      As Variant
    Dim r       As Variant
    Dim result  As Variant

    r1 = Application.Transpose(Worksheets(1).Range("C1:C10"))
    r2 = Application.Transpose(Worksheets(2).Range("A:A")) 'up to 65536th row!

    For Each r In r1
        result = Application.Match(r, r2, 0)
        If Not IsError(result) Then
            Debug.Print r & " is found!"
        End If
    Next r

End Sub

代码只读取两个范围一次，之后它在VBA环境中运行，速度明显加快。

MSDN WorksheetFunciton.Match

Answer 2

请尝试此代码。但是，在检查顶部的枚举之前。您可以在此处确定哪个列在哪个工作表中。根据需要更改。并且，BTW，Enums必须在任何程序之前位于代码表的顶部。

您还需要更改两个工作表的名称。我打电话给“RawData”和“Groups”。将这些名称替换为工作簿中的名称。

最后，我假设组名，我不得不假设它们在B列（更改枚举以匹配事实）位于合并的单元格中。如果不是，代码将无法工作。（如果需要，可以进行调整。）如果RawData！A1是水平合并的单元格，它也将无效。

Option Explicit

Enum Nsg                        ' Sheet "Groups"
    ' 25 Jan 2018
    NsgFirstDataRow = 2
    NsgGroup = 2                ' 2 = column B
    NsgCustom
End Enum

Enum Nsd                        ' Sheet "Data"
    ' 25 Jan 2018
    NsdFirstDataRow = 2
    NsdCustom = 1               ' 1 = column A
End Enum


Sub FindGroups()
    ' 25 Jan 2018

    Dim Msg As String
    Dim Spike As String                         ' result collector
    Dim ArrCustom As Variant
    Dim SearchRng As Range
    Dim R As Long, Rstart As Long, Rend As Long
    Dim Rc As Long                              ' Customers

    With Worksheets("RawData")
        R = .Cells(.Rows.Count, NsdCustom).End(xlUp).Row
        Set SearchRng = Range(.Cells(NsdFirstDataRow, NsdCustom), _
                              .Cells(R, NsdCustom))
    End With

    With Worksheets("Groups")
        ArrCustom = Range(.Cells(1, NsgCustom), _
                          .Cells(.Rows.Count, NsgCustom).End(xlUp))
        R = NsgFirstDataRow
        Do While R <= UBound(ArrCustom)
            Rstart = R
            Rend = Rstart + .Cells(R, NsgGroup).MergeArea.Rows.Count - 1
            R = Rend + 1
            For Rc = Rstart To Rend
                If FindCustomer(ArrCustom(Rc, 1), SearchRng) Then
                    Spike = Spike & Chr(13) & .Cells(Rstart, NsgGroup).Value
                    Exit For
                End If
            Next Rc
        Loop
    End With

    Msg = IIf(Len(Spike), "The following", "No")
    MsgBox Msg & " groups were found in the raw data." & Spike, _
           vbInformation, "Search report"
End Sub

Private Function FindCustomer(ByVal Custom As String, _
                              SearchRng As Range) As Boolean
    ' 25 Jan 2018

    Dim Fnd As Range

    With SearchRng
        Set Fnd = .Find(What:=Custom, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
    End With
    FindCustomer = Not (Fnd Is Nothing)
End Function

优化代码以匹配2张纸上的2个值

2 个答案: