Option Explicit
Sub TEST()
Dim Brr, Z, i&
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([E2], [D65536].End(3))
For i = 1 To UBound(Brr): Z(Val(Brr(i, 1))) = Brr(i, 2) & "": Next
Brr = Range([B2], [B65536].End(3))
For i = 1 To UBound(Brr)
If Trim(Brr(i, 1)) Like "#*" = False Then Brr(i, 1) = "": GoTo i01
Brr(i, 1) = Z(Val(Left(Format(Brr(i, 1), "00000"), 1)))
i01: Next
[H2].Resize(UBound(Brr)) = Brr
End Sub