Excel VBA: Stocker la valeur d'une cellule dans une variable si une certaine valeur existe dans la même colonne

Question

J'essaie de déterminer comment stocker la valeur d'une cellule dans une variable si une certaine valeur existe dans la même colonne . Voir l'explication ci-dessous:

Exemple Tableau

Ainsi, par exemple, j'ai une base de données stockant si une personne bénéficie d'un certain fruit ou non. Ce que je veux arriver est que pour chaque personne, aller rangée par rangée dans myRange (où myRange = "B" i & ": E" & i) si la cellule est = Chr (13) & Chr (7) puis stocker le . la valeur de l'en-tête dans une variable (par exemple "Apple", "raisin", banane », "orange")

C'est ce que j'ai en ce moment comme un extrait:

For i = 7 To iLastRow 
    Set oCell = myRange.Find(What:=Chr(13) & Chr(7), LookIn:=xlValues, _ 
       LookAt:=xlWhole, SearchOrder:=xlByRows, _ 
       SearchDirection:=xlNext, :=False, SearchFormat:=False) 

    If oCell = Chr(13) & Chr(7) Then 
     value = "DONT KNOW WHAT TO PUT HERE BUT IT WILL REFERENCE TO THE 
       ITEMS 'Apple', 'Grape','Banana', 'Orange' DEPENDING ON WHICH 
       COLUMN THE BLANK IS FOUND IN" 
     sTemp = sTemp & "," & value 
    Else 
     Set oCell = Nothing 
    End If 
Next i 
sTemp = Mid(sTemp, 2) 

Answer 1

Ici ' s une autre en utilisant une boucle en boucle qui donne un résultat msgbox comme:

"Joe aime Orange, James aime Apple, banane, raisin, John aime Apple, banane, orange, Jack aime Pomme, Raisin,"

Sub what() 
Dim P As String: Dim X As String: Dim S As String 
Dim i As Integer: Dim j As Integer: Dim iLastRow As Integer 
With ThisWorkbook.Worksheets("Sheet3") 
    iLastRow = 10 
    For i = 7 To iLastRow 
     P = .Cells(i, 1).Value2 
     For j = 2 To 5 
      If .Cells(i, j).Value = "Y" Then 
       V = .Cells(6, j).Value 
       S = S & V & ", " 
      End If 
     Next j 
     X = P & " likes " & S & vbNewLine & X 
     S = "" 
    Next i 
End With 
MsgBox X 
End Sub 

Answer 2

Check this out mec, je pense que cela vous aidera à comprendre votre problème

Private Sub this() 
    Dim arr As Variant, strPerson As String, strFruit As String 
    arr = ThisWorkbook.Sheets("Sheet1").UsedRange 
    For i = LBound(arr, 1) To UBound(arr, 1) 
     For j = LBound(arr, 2) To UBound(arr, 2) 
      If arr(i, 1) <> arr(1, 1) Then 
       If arr(i, j) = arr(i, 1) Then strPerson = arr(i, j) 
       If arr(i, j) <> arr(i, 1) Then 
        If arr(i, j) = "y" Then 
         strFruit = arr(1, j) 
         strPerson = strPerson & strFruit 
        End If 
       End If 
      End If 
     Next j 
     Debug.Print ; strPerson 
    Next i 
End Sub