值在一个范围内存在多次,需要提取相应的行值

时间:2016-08-19 09:01:01

标签: excel excel-vba vba

我是Excel的学习者,我喜欢学习新事物。

值在B2:Z20范围内多次存在。值不在一行中复制,即它在该范围内仅连续出现一次。需要计算值A中每个条目的A列中相应行的值。

例如价值" XYZ"分别存在于行1,4,5,9和12的B,D,E,H,J列中。需要在不同列中的行1,4,5,9和12中的A列中提取相应的值。

1 个答案:

答案 0 :(得分:0)

试试这个:

Sub SearchRange()
    Dim rFound As Range, rng As Range, foundRng As Range
    Dim strName As String
    Dim count As Long, LastRow As Long

    Set rng = Range("B2:Z20")    '->set you range here

    strName = "xyz"    '->enter search string here
    With rng
        Set rFound = .Find(What:=strName, LookIn:=xlValues, LookAt:=xlWhole)
        If Not rFound Is Nothing Then
            FirstAddress = rFound.Address
            Do
                Debug.Print rFound.Address    '->found cell address
                MsgBox Range("A" & rFound.Row).Value    '-> corresponding Column A value
                Set rFound = .FindNext(rFound)
            Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress
        End If
    End With
End Sub

编辑#1 ___________________________________________________________________________

Sub SearchRange()
    Dim rFound As Range, rng As Range, foundRng As Range
    Dim strName As String
    Dim count As Long, LastRow As Long

    Set rng = Range("B2:Z20")    '->set you range here

    For Each cel In Range("AA1:AA5")    '->assuming your search strings are in this range
        strName = cel.Value
        With rng
            Set rFound = .Find(What:=strName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not rFound Is Nothing Then
                FirstAddress = rFound.Address
                Do
                    Debug.Print rFound.Address    '->found cell address
                    MsgBox rFound.Address & " : " & Range("A" & rFound.Row).Value
                    Set rFound = .FindNext(rFound)
                Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress
            End If
        End With
    Next cel
End Sub

编辑#2 ___________________________________________________________________________

Sub SearchRange()
    Dim rFound As Range, rng As Range, foundRng As Range
    Dim strName As String
    Dim count As Long, LastRow As Long, rowCntr As Long, colCntr As Long
    Dim wb As Workbook
    Dim dataWB As Worksheet, resultWB As Worksheet

    Set wb = ThisWorkbook
    Set dataWB = wb.Sheets("Sheet1")   '->change to sheet where your data is
    Set resultWB = wb.Sheets("Sheet2")    '->change to sheet where result needs to be displayed

    Set rng = Range("B2:Z20")    '->set you range here

    rowCntr = 1
    For Each cel In dataWB.Range("AA1:AA3")    '->assuming your search strings are in this range
        strName = cel.Value
        With rng
            Set rFound = .Find(What:=strName, LookIn:=xlValues, LookAt:=xlWhole)
            resultWB.Range("A" & rowCntr) = strName    '->enter searched value in result sheet
            If Not rFound Is Nothing Then
                colCntr = 2
                FirstAddress = rFound.Address
                Do
                    '->display corresponding Column A values in result sheet
                    resultWB.Cells(rowCntr, colCntr) = dataWB.Range("A" & rFound.Row).Value
                    Set rFound = .FindNext(rFound)
                    colCntr = colCntr + 1
                Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress
            End If
        End With
        rowCntr = rowCntr + 1
    Next cel
End Sub