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
我正在尝试确定如果同一列中存在特定值,如何将单元格的值存储在变量中。请看下面的解释:
示例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