Excel VBA: 如果同一列中存在某个值,则将一个单元格的值存储在变量中

Excel VBA: Storing the Value of One Cell in a Variable if a Certain Value Exists in the Same Column

我正在尝试确定如果同一列中存在特定值,如何将单元格的值存储在变量中。请看下面的解释:

示例Table

例如,我有一个数据库存储一个人是否喜欢某种水果。我想要发生的是,对于每个人,如果单元格是 = Chr(13) & Chr(7),则在 myRange 中逐行(其中 myRange = "B" i & ":E" & i)将 header 的值存储在变量中(即 "Apple"、"Grape"、Banana"、"Orange")。

这是我现在的片段:

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)

看看这个伙计,我想这会帮助你找出你的问题

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

这是一个使用循环的循环的替代方法,它给出的 msgbox 结果为:

“乔喜欢橙色, 詹姆斯喜欢苹果、香蕉、葡萄, 约翰喜欢苹果、香蕉、橙子、 杰克喜欢苹果、葡萄,"

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