Xin trợ giúp code tìm Kiếm giá trị cho của ô Trống

[TuPham86]

Em chào các bác. Em có bài toán muốn nhờ trợ giúp của các bác ạ. E có một ô giá trị cột B, bài toàn của e là muốn tìm kiếm trong ô giá trị những vị trí ô trống cột A để ra bảng giá trị cầm tìm, Giả sử ô A5 trống ta tìm được ra giá trị D2 -->F2 (1 ....4,5....5.5) theo hình vẽ. và các ô tìm kiếm ở dưới cũng tương tự. Giá trị cần tìm là bảng bên cạnh ạ. Em xin cảm ơn các bác nhiều.
File em có đính kèm phía dưới ạ.

 

[HUONGHCKT]

Em chào các bác. Em có bài toán muốn nhờ trợ giúp của các bác ạ. E có một ô giá trị cột B, bài toàn của e là muốn tìm kiếm trong ô giá trị những vị trí ô trống cột A để ra bảng giá trị cầm tìm, Giả sử ô A5 trống ta tìm được ra giá trị D2 -->F2 (1 ....4,5....5.5) theo hình vẽ. và các ô tìm kiếm ở dưới cũng tương tự. Giá trị cần tìm là bảng bên cạnh ạ. Em xin cảm ơn các bác nhiều.
File em có đính kèm phía dưới ạ.

Thử code này xem sao. hy vọng đúng ý.
Sub VBA()
Dim i&, t&, d&
Dim Arr(), KQ()

With Sheet1
.Range("D2:F1000").ClearContents
d = .Range("A" & Rows.Count).End(xlUp).Row
Arr = .Range("A2:B" & d).Value

ReDim KQ(1 To UBound(Arr), 1 To 3)
For i = 1 To UBound(Arr) - 1
If Arr(i + 1, 1) = Empty And Arr(i, 1) <> Empty Then
t = t + 1
KQ(t, 1) = t
KQ(t, 2) = Arr(i, 2)
KQ(t, 3) = Arr(i + 1, 2)
End If
If Arr(i + 1, 1) = Empty And Arr(i, 1) = Empty Then
t = t + 1
KQ(t, 1) = t
KQ(t, 2) = Arr(i, 2)
KQ(t, 3) = Arr(i + 1, 2)
End If

Next i
If t > 0 Then .[D2].Resize(t, 3) = KQ
End With
Msgbox " XONG RÔI"
End Sub

 

[TuPham86]

Thử code này xem sao. hy vọng đúng ý.
Sub VBA()
Dim i&, t&, d&
Dim Arr(), KQ()

With Sheet1
.Range("D2:F1000").ClearContents
d = .Range("A" & Rows.Count).End(xlUp).Row
Arr = .Range("A2:B" & d).Value

ReDim KQ(1 To UBound(Arr), 1 To 3)
For i = 1 To UBound(Arr) - 1
If Arr(i + 1, 1) = Empty And Arr(i, 1) <> Empty Then
t = t + 1
KQ(t, 1) = t
KQ(t, 2) = Arr(i, 2)
KQ(t, 3) = Arr(i + 1, 2)
End If
If Arr(i + 1, 1) = Empty And Arr(i, 1) = Empty Then
t = t + 1
KQ(t, 1) = t
KQ(t, 2) = Arr(i, 2)
KQ(t, 3) = Arr(i + 1, 2)
End If

Next i
If t > 0 Then .[D2].Resize(t, 3) = KQ
End With
Msgbox " XONG RÔI"
End Sub

Đúng ý mình rồi. Cảm ơn bạn nhiều nhé.