基于单元格选择范围并返回相邻单元格

Question

问候语， 我正在尝试查找函数公式或vba宏来解决此问题。感谢您对此事的支持和帮助。 我在列C中有一个列表，你可以看到，我想在基于范围的数据范围之间得到一个特定的单元格，在这种情况下我选择列F中的数字。例如： 我想选择1000到2000之间的单元格然后得到名为“Apple”的特定单元格，它在G2中使用偏移量公式返回相邻单元格以获得D4“红色” 解决方案就像右表，其中所有数据都是基于指定的范围。 非常感谢您的支持。 d

Answer 1

该代码不像它可能是动态的，但它工作如果表的列是静态的。

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