durch Bezugnahme auf 2 Werte in einer Spalte aus einer Zeile zwei Spiele abrufen

Question

Ich habe eine Datei mit drei Haupt-Namen in einer Spalte.

Names 
------ 
George 
John 
Victor 

unter den Namen in der Spalte A Ich habe 3 Kategorien

food 
drink 
super 

auf der rechten Seite der Datei, ich habe Daten 1 + 2 + 3

beachten Sie, dass die drei Kategorien sind nicht in derselben Reihenfolge die Zeit.

Was ist der beste Weg, Datenpunkt 3 für jeden Namen mit der Kategorie Getränke und Lebensmittel nur in einer anderen Zelle abzurufen?

Dank

Answer 1

Edit: Ok, jetzt verstehe ich das ganze Ausmaß des Problems, die folgende Code tatsächlich tun, was Sie benötigen. Versuchen Sie in Zukunft, die Grenzen der Variablen, die Sie verarbeiten müssen, und die Grenzen oder Einschränkungen, die Sie bearbeiten müssen, zu erklären.

Ihre eingefügten Kopie Ihrer Arbeitsmappe feststellend, sollten folgende Arbeiten:

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