基於單元格選擇範圍並返回相鄰單元格

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