查找具有 2 个条件的单元格行答案

【问题标题】：Find cell row with 2 criteria查找具有 2 个条件的单元格行
【发布时间】：2021-04-14 20:38:22
【问题描述】：

是否可以找到具有 2 个条件的行？我正在将调查答案导入工作表，现在我想查找指定人员的答案
我需要在 worksheet(ImportLimesurvey) 中找到具有 2 个指定单元格值的行：

在那一行：

C 单元格的值必须是该列中的最大值之一（我使用了函数 Application.WorksheetFunction.Max(rng)）

此值表示填写了多少调查问卷。最高值位于多个答案行中。每次调查的最高值都不同。（例如，如果一项调查有 7 页并且参与者填写了所有页面：该人的最高值为 7，但如果该人未完成该调查，则该值可能是例如 3），所以过滤器最高值是参与者是否完成了整个调查。

L 单元格的值必须与单元格相同 (Worksheets("Dataimport").Range("M2")

M2= 我需要回答的人的帐号

必须将正确的行粘贴到 (Worksheets("Dataimport").Range("A7")

这是我当前的代码：

Dim g As Range
Dim rng As Range
Set rng = Worksheets("ImportLimesurvey").Range("C:C")

d = Application.WorksheetFunction.Max(rng)

With Worksheets("ImportLimesurvey").Range("L:L")
    Set g = .Find(Worksheets("Dataimport").Range("M2"), LookIn:=xlValues)
    g.Activate
End With
e = Range("C" & (ActiveCell.Row))
If e = d Then
ActiveCell.EntireRow.Copy _
Destination:=Worksheets("Dataimport").Range("A7")
End If

这里的问题是他找到了具有正确帐号的行，但具有 C 值的答案并不总是最高的。它（逻辑上）只选择具有该帐号的第一行。那么如何找到符合这两个条件的行呢？

提前致谢

附：我是 VBA 新手，所以我尽量做到具体，但如果您需要任何其他信息，请直接询问；）

【问题讨论】：

你能提供一些样本数据吗？在解决答案之前，我想澄清一些事情；您的数据集中通常有多少行，平均有多少个帐号将包含在数据集中，目标帐号是在整个数据中随机出现还是全部分组在一起（如果同一号码有多个行）？
可能最好的方法是使用查找/查找下一个。在第一次查找时，将 C 单元格中的值保存到变量中，并将行号保存到变量中。然后继续FindNext 该人的每个实例。在每个实例中，对照您存储的 C 单元格值检查它是否更大。如果是，则用这个新的替换它，并将存储的行号替换为新的。继续进行，直到所有实例都完成，您将拥有所需的行。否则你可以做一个For 循环，这对我来说更容易，你可以将数据拉入一个数组以使其更快。
@SamuelEverson 调查保持开放状态，每次有新参与者/客户时都会出现新的答案行。所以它可能会在 10 年内不断增加，我有 1000 行。 acc°nr 是每个客户随机生成的数字。但是如果有人再次回答这个问题，因为它之前没有完成并且必须重新开始。它与以前未完成的答案具有相同的accnr°。相同的accnr°不会被分组。该行由回答的时间定义。因此，如果您在第一次回答后 10 天回答。您的 2 个答案之间可能有答案。

标签： excel vba find criteria

【解决方案1】：

dmt32 forom mrexcel.com 找到了解决方案。

主题链接：https://www.mrexcel.com/board/threads/find-row-with-2-criteria.1157983/

他的代码运行良好：

Sub FindMaxValue()
    Dim FoundCell   As Range, rng As Range
    Dim MaxValue    As Long
    Dim Search      As String, FirstAddress As String
    Dim wsDataImport As Worksheet, wsImportLimesurvey As Worksheet
   
    With ThisWorkbook
        Set wsDataImport = .Worksheets("Dataimport")
        Set wsImportLimesurvey = .Worksheets("ImportLimesurvey")
    End With
   
    Search = wsDataImport.Range("M2").Value
    If Len(Search) = 0 Then Exit Sub
   
    With wsImportLimesurvey
   
        Set FoundCell = .Range("L:L").Find(Search, LookIn:=xlValues, lookat:=xlWhole)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            Do
               
                With FoundCell.Offset(, -9)
                    If .Value > MaxValue Then Set rng = FoundCell: MaxValue = .Value
                End With
               
                Set FoundCell = .Range("L:L").FindNext(FoundCell)
                If FoundCell Is Nothing Then Exit Do
            Loop Until FoundCell.Address = FirstAddress
           
            rng.EntireRow.Copy wsDataImport.Range("A7")
            MsgBox Search & Chr(10) & "Record Copied", 64, "Match Found"
           
        Else
            MsgBox Search & Chr(10) & "Record Not Found", 48, "Not Found"
        End If
    End With
End Sub

仍然感谢您的提示。

【讨论】：

【解决方案2】：

首先，Visual Basic conceptual topics 是一本很好的读物，有助于编写“更好”的代码。我最鼓励的是使用有意义的变量名。

当您使用 HighestCount 或 TargetSheet 等变量名称而不是 a 或 b 等名称时，更容易理解您的代码。

你的问题的答案是肯定的。

我会这样写：

Option Explicit

Public Function HighestSurveyRow(ByVal TargetAccountNumber As Long) As Long

    Dim ImportLimeSurveySheet As Worksheet
    Set ImportLimeSurveySheet = ThisWorkbook.Sheets("ImportLimeSurvey")
    
    Dim LastRow As Long
    Dim TargetRow As Long
    Dim SurveyCountArray As Variant
    Dim ArrayCounter As Long
    
    With ImportLimeSurveySheet
        ArrayCounter = 1
        LastRow = .Cells(.Rows.Count, 12).End(xlUp).Row
        ReDim SurveyCountArray(1 To LastRow, 1 To 2)
        For TargetRow = 1 To LastRow
            If .Cells(TargetRow, 12).Value = TargetAccountNumber Then
                SurveyCountArray(ArrayCounter, 2) = TargetRow
                SurveyCountArray(ArrayCounter, 1) = .Cells(TargetRow, 3).Value
                ArrayCounter = ArrayCounter + 1
            End If
        Next TargetRow
    End With
    
    Dim ResultArray(1 To 2) As Variant
    Dim ArrayElement As Long
    
    For ArrayElement = 1 To UBound(SurveyCountArray, 1)
        If SurveyCountArray(ArrayElement, 1) > ResultArray(1) Then
            ResultArray(1) = SurveyCountArray(ArrayElement, 1)
            ResultArray(2) = SurveyCountArray(ArrayElement, 2)
        End If
    Next ArrayElement
    
    HighestSurveyRow = ResultArray(1)

End Function

Sub FindRowForSurveyResults()
 
    With ThisWorkbook.Sheets("DataImport")
        .Range("A7").Value = HighestSurveyRow(.Range("M2").Value)
    End With

End Sub

它分为Function 和Subroutine。该函数执行大部分代码并返回行号。 Sub 调用此函数并将此返回值写入“DataImport”上的单元格 A7。

子可以分解如下；

使用 with 语句有助于减少两次定义工作表的代码混乱。
子程序唯一要做的就是为单元格 A7 赋值。为了获取值，它调用函数并将参数 TargetAccountNumber 分配为单元格 M2 中的值。

函数可以分解为以下几个步骤；

声明所有变量并设置函数的目标工作表。
找到 L 列的 LastRow 以确定我们的数组的最大长度和搜索范围。
循环从第 1 行搜索到 LastRow，并比较 L 列的值。如果它与 TargetAccountNumber 参数匹配，则 C 列的值和行号将存储到数组中。
循环完成后，将运行另一个循环以查找最高编号。第一次迭代将始终存储第一行的数据。之后的每次迭代都会将存储在SurveyCountArray 中的值与ResultArray(1) 的当前值进行比较，如果值更大，ResultArray(1) 会更新为该值，ResultArray(2) 会更新为行号。
第二个循环完成后，ResultArray(2) 中的 Row 将分配给 Sub 写入工作表的函数。

它肯定可以改进和完善以更快、更高效地工作，尤其是在您拥有非常大的数据集时，但这应该有助于您思考使用循环和数组查找数据的方法。

注意：结果可能有重复的行（比如用户提交相同的调查 3 次，答案相同），我没有测试过 - 我认为这段代码会返回符合所需条件的最高行号，但可以进行调整以引发错误或消息，甚至将所有行号写入工作表。

【讨论】：