Sub Sub_200370()

Const RA = "A1"             ' Адрес ячейки с первым элементом массива чисел
    
Dim N, CN, ierr
Dim RRA, In10, N1, N2, i, j
Dim RB, RRB
Dim RC, RRC
Dim RD, RRD

N = InputBox("Введите целое N>0")

ierr = False
If IsNumeric(N) Then
    CN = CDbl(N)
    ierr = CDbl(CN) > 0 And Int(CN) = CN
End If

If Not ierr Then
    MsgBox "Введено неверное число" + vbCrLf + N
    Exit Sub
End If

ReDim In10(1 To N, 1) As Single
ReDim In16(1 To N)
ReDim Out10(1 To N)

Cells.Interior.Pattern = xlNone
Cells.Font.ColorIndex = xlAutomatic
    
RRA = RA + ":" + Range(RA).Offset(N - 1, 0).Address

RB = Range(RA).Offset(0, 1).Address
RRB = RB + ":" + Range(RB).Offset(N - 1, 0).Address

RC = Range(RA).Offset(0, 2).Address
RRC = RC + ":" + Range(RC).Offset(N - 1, 0).Address
    
In10 = Range(RRA)
N1 = LBound(In10, 1)
N2 = UBound(In10, 1)

For i = N1 To N2
    If IsNumeric(In10(i, 1)) And Len(Trim(In10(i, 1))) > 0 Then
        Range(RA).Offset(i - 1, 0).Font.Color = -11489280
        In16(i) = CStr(Application.WorksheetFunction.Dec2Hex(In10(i, 1)))
        Out10(i) = Application.WorksheetFunction.Hex2Dec(Exch(CStr(In16(i))))
    Else
        Range(RA).Offset(i - 1, 0).Font.Color = -16776961
        In16(i) = ""
        Out10(i) = ""
    End If
Next

Range(RRB) = Application.WorksheetFunction.Transpose(In16)
Range(RRC) = Application.WorksheetFunction.Transpose(Out10)

End Sub

Function Exch(S As String)
    Dim SS, k, j
    k = Len(Trim(S))
    SS = ""
    For j = k To 1 Step -1
        SS = SS + Mid(S, j, 1)
    Next
    Exch = SS
End Function