通过引用列中的2个值从一行中检索两个匹配项

Question

我在一个列中有一个包含3个主要名称的文件。

Names
------
George
John
Victor

列A下面的名称

我有3个类别

food
drink
super

在文件右侧我有数据1 + 2 + 3

请注意，3个类别始终不在同一个顺序中。

为每个名称检索数据点3的最佳方法是什么，只在另一个单元格中使用类别饮料和食物？

由于

Answer 1

编辑：好的，现在我了解您问题的全部范围，下面的代码实际上会满足您的需求。将来，请尝试解释您需要处理的变量的限制，以及您需要处理的限制或约束。

注意粘贴的工作簿副本，以下内容应该有效：

Sub Get_Third_Value()
    Dim Totals() As Variant, Names() As String, Cats() As String
    Dim X As Integer, Cur_Pers As Integer, Y As Integer, Z As Integer, No_Cats As Integer, No_Ppl As Integer, Last_Row As Integer
    Dim Tmp_Val As String
    ReDim Totals(1 To 7, 1 To 1) As Variant
    ReDim Names(1 To 1) As String
    ReDim Cats(1 To 1) As String
    Dim Data As Variant
    Do
        'This lets the user determine which data column they wish to total.
        Data = -1
        Data = InputBox("Please state which Data Value you wish to total:", "Total which Data:", "3")
        If IsNumeric(Data) = False Then Data = -1
    Loop Until Data > 0 And Data < 4
    For X = 2 To 10000
        'This for loop is used to generate a list of People's Names and the Categories of data (E.G. Food, Drink, Super, etc).
        'There is an assumption that there will only be a maximum of 7 Categories.
        If Range("A" & X).Value = "" Then
                'This ensures that at the end of the list of data the process ends.
                Last_Row = X - 1
                Exit For
        End If
        Tmp_Val = LCase(Range("A" & X).Value)
        If No_Cats <> 0 Then
                For Y = 1 To No_Cats
                    If Tmp_Val = Cats(Y) Then GoTo Already_Added 'This checks the array of Categories and skips the remainder if this already exists in that array.
                Next Y
        End If
        For Y = (X + 1) To 10000
            If Range("A" & Y).Value = "" Then GoTo Add_Name 'If the value is not repeated in the list, it must be someone's name.
            If Tmp_Val = LCase(Range("A" & Y).Value) Then
                    'If the value is repeated in the list in Column A, it must be a Category of data.
                    If No_Cats = 0 Then
                            'When no Categories have been added to the array of Categories, then the first is just added.
                            No_Cats = 1
                            ReDim Preserve Cats(1 To No_Cats) As String
                            Cats(No_Cats) = Tmp_Val
                        Else
                            'If the Category wasn't already found in the array of Categories, then this adds it.
                            No_Cats = No_Cats + 1
                            ReDim Preserve Cats(1 To No_Cats) As String
                            Cats(No_Cats) = Tmp_Val
Dont_Add_Cat:
                    End If
                    'Once the category has been added, then you don't need to keep checking the list.
                    GoTo Already_Added
            End If
        Next Y
Add_Name:
        No_Ppl = No_Ppl + 1
        ReDim Preserve Names(1 To No_Ppl) As String
        ReDim Preserve Totals(1 To 7, 1 To No_Ppl) As Variant
        Names(No_Ppl) = Tmp_Val
Already_Added:
    Next X
    For X = 2 To Last_Row
        For Y = 1 To No_Ppl
            'This for loop checks the current row against the list of names.
            If LCase(Range("A" & X).Value) = Names(Y) Then
                    Cur_Pers = Y
                    Exit For
            End If
        Next Y
        For Y = 1 To No_Cats
            'This for loop checks the current row against the array of Categories and increments the total as required.
            If LCase(Range("A" & X).Value) = Cats(Y) Then
                    Totals(Y, Cur_Pers) = Totals(Y, Cur_Pers) + CInt(Range(Cells(X, Data + 1).Address).Value)
                    Exit For
            End If
        Next Y
    Next X
    With Range(Cells(Last_Row + 2, 3).Address & ":" & Cells(Last_Row + 2, 2 + No_Cats).Address)
        .Merge
        .Value = "Data " & Data
        .HorizontalAlignment = xlCenter
    End With
    For X = 1 To No_Ppl
        Range("B" & X + (Last_Row + 4)).Value = UCase(Left(Names(X), 1)) & Right(Names(X), Len(Names(X)) - 1)
    Next X
    For Y = 1 To No_Cats
        Range(Cells(Last_Row + 3, 2 + Y).Address).Value = "Sum of " & Cats(Y)
        Range(Cells(Last_Row + 4, 2 + Y).Address).Value = Cats(Y)
        For X = 1 To No_Ppl
            Range(Cells(Last_Row + 4 + X, 2 + Y).Address).Value = Totals(Y, X)
        Next X
    Next Y
End Sub