问候语, 我试图找到一个函数公式或一个vba宏来解决这个问题。感谢您对此事的支持和帮助。 我在C列中有一个列表,你可以看到,我希望得到一个基于范围的数据范围之间的特定单元格,我在这种情况下选择F列中的数字。例如: 我想选择1000到2000之间的单元格然后得到名为“Apple”的特定单元格,它在G2中使用偏移公式返回相邻单元格以获得D4“红色” 解决方案就像右表一样,所有数据都根据指定的范围填充。 感谢您的支持。 d
答案 0 :(得分:0)
代码不是动态的,但是如果表的列是静态的,它就可以工作。
Dim row As Byte, lastRow As Byte
Dim currentNumber As Long
Dim currentText As String
With ActiveWorkbook.Sheets(1)
lastRow = .Cells(.Rows.Count, "B").End(xlUp).row
For row = 2 To lastRow
If Not (IsEmpty(.Cells(row, 2))) Then
If (IsNumeric(.Cells(row, 2))) Then
currentNumber = .Cells(row, 2)
ElseIf (Len(.Cells(row, 2) > 0)) Then
currentText = .Cells(row, 2)
Select Case currentNumber
Case 1000
If StrComp(currentText, "Apple", vbTextCompare) = 0 Then
.Cells(3, 6) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Banana", vbTextCompare) = 0 Then
.Cells(3, 7) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Orange", vbTextCompare) = 0 Then
.Cells(3, 8) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Mobile", vbTextCompare) = 0 Then
.Cells(3, 9) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Car", vbTextCompare) = 0 Then
.Cells(3, 10) = .Cells(row, 2).Offset(0, 1)
End If
Case 2000
If StrComp(currentText, "Apple", vbTextCompare) = 0 Then
.Cells(4, 6) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Banana", vbTextCompare) = 0 Then
.Cells(4, 7) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Orange", vbTextCompare) = 0 Then
.Cells(4, 8) = .Cells(row, 2).Offset
ElseIf StrComp(currentText, "Mobile", vbTextCompare) = 0 Then
.Cells(4, 9) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Car", vbTextCompare) = 0 Then
.Cells(4, 10) = .Cells(row, 2).Offset(0, 1)
End If
Case 5000
If StrComp(currentText, "Apple", vbTextCompare) = 0 Then
.Cells(5, 6) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Banana", vbTextCompare) = 0 Then
.Cells(5, 7) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Orange", vbTextCompare) = 0 Then
.Cells(5, 8) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Mobile", vbTextCompare) = 0 Then
.Cells(5, 9) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Car", vbTextCompare) = 0 Then
.Cells(5, 10) = .Cells(row, 2).Offset(0, 1)
End If
Case 7000
If StrComp(currentText, "Apple", vbTextCompare) = 0 Then
.Cells(6, 6) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Banana", vbTextCompare) = 0 Then
.Cells(6, 7) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Orange", vbTextCompare) = 0 Then
.Cells(6, 8) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Mobile", vbTextCompare) = 0 Then
.Cells(6, 9) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Car", vbTextCompare) = 0 Then
.Cells(6, 10) = .Cells(row, 2).Offset(0, 1)
End If
Case 10000
If StrComp(currentText, "Apple", vbTextCompare) = 0 Then
.Cells(7, 6) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Banana", vbTextCompare) = 0 Then
.Cells(7, 7) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Orange", vbTextCompare) = 0 Then
.Cells(7, 8) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Mobile", vbTextCompare) = 0 Then
.Cells(7, 9) = .Cells(row, 2).Offset(0, 1)
ElseIf StrComp(currentText, "Car", vbTextCompare) = 0 Then
.Cells(7, 10) = .Cells(row, 2).Offset(0, 1)
End If
End Select
End If
End If
Next row
End With