根据单元格选择范围并返回相邻单元格

时间:2017-04-07 23:32:40

标签: excel vba excel-vba

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

1 个答案:

答案 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