2進数、10進数、16進数の相互変換 | ～ 車輪の再発明シリーズ ～ http://www.moug.net/faq/viewtopic.php?t=65742

Module.vb

Option Explicit

Sub test()
    Hex2DecTest
    Dec2BinTest
    Hex2BinTest
    Bin2DecTest
    Bin2HexTest
    Dec2HexTest
End Sub

Sub Hex2DecTest()
    Debug.Assert Hex2Dec("0") = "0"
    Debug.Assert Hex2Dec("1") = "1"
    Debug.Assert Hex2Dec("2") = "2"
    Debug.Assert Hex2Dec("3") = "3"
    Debug.Assert Hex2Dec("4") = "4"
    Debug.Assert Hex2Dec("5") = "5"
    Debug.Assert Hex2Dec("6") = "6"
    Debug.Assert Hex2Dec("7") = "7"
    Debug.Assert Hex2Dec("8") = "8"
    Debug.Assert Hex2Dec("9") = "9"
    Debug.Assert Hex2Dec("A") = "10"
    Debug.Assert Hex2Dec("B") = "11"
    Debug.Assert Hex2Dec("C") = "12"
    Debug.Assert Hex2Dec("D") = "13"
    Debug.Assert Hex2Dec("E") = "14"
    Debug.Assert Hex2Dec("F") = "15"
End Sub

Sub Dec2BinTest()
    Debug.Assert Dec2Bin("0") = "0"
    Debug.Assert Dec2Bin("1") = "1"
    Debug.Assert Dec2Bin("2") = "10"
    Debug.Assert Dec2Bin("3") = "11"
    Debug.Assert Dec2Bin("4") = "100"
    Debug.Assert Dec2Bin("5") = "101"
    Debug.Assert Dec2Bin("6") = "110"
    Debug.Assert Dec2Bin("7") = "111"
    Debug.Assert Dec2Bin("8") = "1000"
    Debug.Assert Dec2Bin("9") = "1001"
    Debug.Assert Dec2Bin("10") = "1010"
    Debug.Assert Dec2Bin("11") = "1011"
    Debug.Assert Dec2Bin("12") = "1100"
    Debug.Assert Dec2Bin("13") = "1101"
    Debug.Assert Dec2Bin("14") = "1110"
    Debug.Assert Dec2Bin("15") = "1111"
End Sub

Sub Hex2BinTest()
    Debug.Assert Hex2Bin("0") = "0000"
    Debug.Assert Hex2Bin("1") = "0001"
    Debug.Assert Hex2Bin("2") = "0010"
    Debug.Assert Hex2Bin("3") = "0011"
    Debug.Assert Hex2Bin("4") = "0100"
    Debug.Assert Hex2Bin("5") = "0101"
    Debug.Assert Hex2Bin("6") = "0110"
    Debug.Assert Hex2Bin("7") = "0111"
    Debug.Assert Hex2Bin("8") = "1000"
    Debug.Assert Hex2Bin("9") = "1001"
    Debug.Assert Hex2Bin("A") = "1010"
    Debug.Assert Hex2Bin("B") = "1011"
    Debug.Assert Hex2Bin("C") = "1100"
    Debug.Assert Hex2Bin("D") = "1101"
    Debug.Assert Hex2Bin("E") = "1110"
    Debug.Assert Hex2Bin("F") = "1111"
End Sub

Sub Bin2DecTest()
    Debug.Assert Bin2Dec("0") = "0"
    Debug.Assert Bin2Dec("1") = "1"
    Debug.Assert Bin2Dec("10") = "2"
    Debug.Assert Bin2Dec("11") = "3"
    Debug.Assert Bin2Dec("100") = "4"
    Debug.Assert Bin2Dec("101") = "5"
    Debug.Assert Bin2Dec("110") = "6"
    Debug.Assert Bin2Dec("111") = "7"
    Debug.Assert Bin2Dec("1000") = "8"
    Debug.Assert Bin2Dec("1001") = "9"
    Debug.Assert Bin2Dec("1010") = "10"
    Debug.Assert Bin2Dec("1011") = "11"
    Debug.Assert Bin2Dec("1100") = "12"
    Debug.Assert Bin2Dec("1101") = "13"
    Debug.Assert Bin2Dec("1110") = "14"
    Debug.Assert Bin2Dec("1111") = "15"
End Sub

Sub Bin2HexTest()
    Debug.Assert Bin2Hex("0000") = "0"
    Debug.Assert Bin2Hex("0001") = "1"
    Debug.Assert Bin2Hex("0010") = "2"
    Debug.Assert Bin2Hex("0011") = "3"
    Debug.Assert Bin2Hex("0100") = "4"
    Debug.Assert Bin2Hex("0101") = "5"
    Debug.Assert Bin2Hex("0110") = "6"
    Debug.Assert Bin2Hex("0111") = "7"
    Debug.Assert Bin2Hex("1000") = "8"
    Debug.Assert Bin2Hex("1001") = "9"
    Debug.Assert Bin2Hex("1010") = "A"
    Debug.Assert Bin2Hex("1011") = "B"
    Debug.Assert Bin2Hex("1100") = "C"
    Debug.Assert Bin2Hex("1101") = "D"
    Debug.Assert Bin2Hex("1110") = "E"
    Debug.Assert Bin2Hex("1111") = "F"
End Sub

Sub Dec2HexTest()
    Debug.Assert Dec2Hex("0") = "0"
    Debug.Assert Dec2Hex("1") = "1"
    Debug.Assert Dec2Hex("2") = "2"
    Debug.Assert Dec2Hex("3") = "3"
    Debug.Assert Dec2Hex("4") = "4"
    Debug.Assert Dec2Hex("5") = "5"
    Debug.Assert Dec2Hex("6") = "6"
    Debug.Assert Dec2Hex("7") = "7"
    Debug.Assert Dec2Hex("8") = "8"
    Debug.Assert Dec2Hex("9") = "9"
    Debug.Assert Dec2Hex("10") = "A"
    Debug.Assert Dec2Hex("11") = "B"
    Debug.Assert Dec2Hex("12") = "C"
    Debug.Assert Dec2Hex("13") = "D"
    Debug.Assert Dec2Hex("14") = "E"
    Debug.Assert Dec2Hex("15") = "F"
End Sub

Function Dec2Hex(ByVal Dec As String) As String
    'Dec2Hex = Hex$(Dec)

    Dim Dec_ As Variant
    Dim Remainders() As Long
    Dim HexList() As String
    Dim Hex As String
    Dim q As Variant
    Dim i As Long
    Dim u As Long
    Dim n As Long
    
    Dec_ = CDec(Dec)
    i = -1
    Do
        'q = Dec_ \ 16 ' オーバーフロー
        q = Quotient(Dec_, 16)
        i = i + 1
        ReDim Preserve Remainders(i) As Long
        ' Remainders(i) = Dec_ Mod 16
        Remainders(i) = Modular(Dec_, 16)
        If q = 0 Then
            Exit Do
        Else
            Dec_ = q
        End If
    Loop
    
    u = i
    ReDim HexList(u) As String

    For n = 0 To u
        Select Case Remainders(i)
            Case 0 To 9: Hex = CStr(Remainders(i))
            Case 10: Hex = "A"
            Case 11: Hex = "B"
            Case 12: Hex = "C"
            Case 13: Hex = "D"
            Case 14: Hex = "E"
            Case 15: Hex = "F"
        End Select
        HexList(n) = Hex
        i = i - 1
    Next n
    
    Dec2Hex = Join(HexList, "")
End Function

Function Bin2Dec(ByVal Bin As String) As String
    Dim Bit As Long
    Dim Sum As Variant
    Dim n As Long
    Dim i As Long
    Dim Base As Variant
    
    Sum = CDec(0)
    n = Len(Bin)
    For i = 1 To n
        Bit = Mid$(Bin, i, 1)
        
        ' 2^50と2^51の結果が正しくない
        ' 誤→正
        ' 1125899906842620→1125899906842624
        ' 2251799813685250→2251799813685248
        'Base = 2 ^ (n - i)
        
        Base = Power(2, n - i)
        Sum = Sum + (Bit * Base)
    Next i
    
    Bin2Dec = CStr(Sum)
End Function

Function Bin2Hex(ByVal Bin As String) As String
    Dim Hex As String
    Dim HexLen As Long
    
    Hex = Dec2Hex(Bin2Dec(Bin))
    HexLen = Quotient(Len(Bin), 4)
    Bin2Hex = Right$(String(HexLen, "0") & Hex, HexLen)
End Function

Function Hex2Dec(ByVal Hex As String) As String
    'Hex2Dec = CStr(CDec("&H" & Hex))

    Dim Hex_ As String
    Dim Dec As Long
    Dim Sum As Variant
    Dim n As Long
    Dim i As Long
    Dim Base As Variant
    
    Sum = CDec(0)
    n = Len(Hex)
    For i = 1 To n
        Hex_ = Mid$(Hex, i, 1)
        Select Case StrConv(Hex_, vbUpperCase)
            Case "0" To "9": Dec = CLng(Hex_)
            Case "A": Dec = 10
            Case "B": Dec = 11
            Case "C": Dec = 12
            Case "D": Dec = 13
            Case "E": Dec = 14
            Case "F": Dec = 15
        End Select
        'Base = 16 ^ (n - i)
        Base = Power(16, n - i)
        Sum = Sum + (Dec * Base)
    Next i
    
    Hex2Dec = CStr(Sum)
End Function

Function Dec2Bin(ByVal Dec As String) As String
    Dim Dec_ As Variant
    Dim Remainders() As Long
    Dim BitList() As String
    Dim q As Variant
    Dim i As Long
    Dim u As Long
    Dim n As Long
    
    Dec_ = CDec(Dec)
    i = -1
    Do
        'q = Dec_ \ 2 ' オーバーフロー
        q = Quotient(Dec_, 2)
        i = i + 1
        ReDim Preserve Remainders(i) As Long
        'Remainders(i) = Dec_ Mod 2 ' オーバーフロー
        Remainders(i) = Modular(Dec_, 2)
        If q = 0 Then
            Exit Do
        Else
            Dec_ = q
        End If
    Loop
    
    u = i
    ReDim BitList(u) As String

    For n = 0 To u
        BitList(n) = CStr(Remainders(i))
        i = i - 1
    Next n
    
    Dec2Bin = Join(BitList, "")
End Function

Function Hex2Bin(ByVal Hex As String) As String
    Dim BinList() As String
    Dim Dec As String
    Dim Bin As String
    Dim n As Long
    Dim i As Long
    
    n = Len(Hex)
    For i = 1 To n
        ReDim Preserve BinList(i - 1) As String
        Dec = Hex2Dec(Mid$(Hex, i, 1))
        Bin = Format$(Dec2Bin(Dec), "0000")
        BinList(i - 1) = Bin
    Next i
    
    Hex2Bin = Join(BinList, "")
End Function