|
Sub AwTest()
Dim i&, x&, r&, Cpy$, arr, brr(1 To 3, 1 To 2), d As Object
Set d = CreateObject("Scripting.Dictionary")
arr = Range("C9:E29")
For i = 1 To UBound(arr)
If InStr(arr(i, 1), "Company") Then
d(Trim(arr(i, 1))) = i
End If
Next
Cpy = Trim(Range("H9").Value)
x = d(Cpy)
If x = 0 Then Exit Sub
brr(1, 2) = arr(x, 3)
Do
x = x + 1
If x > UBound(arr) Then x = 1
If InStr(arr(x, 1), "Company") = 0 Then
r = r + 1
brr(r + 1, 1) = arr(x, 1)
brr(r + 1, 2) = arr(x, 3)
If r = 2 Then Exit Do
End If
Loop
Range("I9").Resize(3, 2) = brr
End Sub |
评分
-
1
查看全部评分
-
|