VBA例7 查找应用

111.jpg

333.jpg

如题，要求查找相应产品的对应指标的合计量

思路

先查找产品名称，然后得出产品名称所占行数，然后在产品名称对应的数据区域匹配要查找指标

细节

因为有两次查找过程，但由于该过程是完成一个功能，所以可以将该功能设计为一个单独的查找函数，以便在过程中调用

代码

Sub t()
    Dim max_r!, arr, data_r, cnt!, i!, brr
    
    data_r = [h1000].End(xlUp).Row
    ReDim brr(1 To data_r)
    arr = Range("h2:i" & data_r)
    max_r = [c66356].End(xlUp).Row
    For i = 2 To data_r
        cnt = findData(arr(i - 1, 1), 1, 2, max_r)
        If cnt = 0 Then
            brr(i - 1) = "查无此产品"
        Else
            cnt = findData(arr(i - 1, 2), 2, cnt, cnt + Cells(cnt, 1).MergeArea.Count - 1)
            If cnt = 0 Then
                brr(i - 1) = "查无此指标"
            Else
                brr(i - 1) = Cells(cnt, 3).Offset(2, 1).Value
            End If
        End If
    Next i
    Cells(2, "j").Resize(data_r) = Application.Transpose(brr)
End Sub

Function findData(find_str, cl, start_r, end_r)
    Dim i!, cnt!
    For i = start_r To end_r
        cnt = Cells(i, cl).MergeArea.Count
        If Cells(i, cl) = find_str Then
            findData = i
            Exit Function
        End If
        i = i + cnt - 1
    Next i
findData = 0
End Function

效果

222.jpg