Option Explicit

' 用途：将十六进制转化为二进制
Public Function Hex2Bin(ByVal HexStr As String) As String
Dim i As Integer
For i = 1 To Len(HexStr)
Hex2Bin = Hex2Bin & Mid("0000;0001;0010;0011;0100;0101;0110;0111;1000;1001;1010;1011;1100;1101;1110;1111;", CLng("&H" & Mid(HexStr, i, 1)) * 5 + 1, 4)
Next
Call DelHead0(Hex2Bin)
End Function

' 用途：将八进制转化为二进制
Public Function Oct2Bin(ByVal OctStr As String) As String
Dim i As Integer
For i = 1 To Len(OctStr)
Oct2Bin = Oct2Bin & Mid$("000;001;010;011;100;101;110;111;", Mid(OctStr, i, 1) * 4 + 1, 3)
Next
Call DelHead0(Oct2Bin)
End Function

' 用途：将二进制转化为十六进制
Public Function Bin2Hex(ByVal BinCode As String) As String
Dim i As Integer, l As Integer
l = Len(BinCode) Mod 4
BinCode = String(4 - l, "0") & BinCode
For i = 1 To Len(BinCode) Step 4
Bin2Hex = Bin2Hex & Hex((InStr("0000;0001;0010;0011;0100;0101;0110;0111;1000;1001;1010;1011;1100;1101;1110;1111;", Mid(BinCode, i, 4)) - 1) / 5)
Next
Call DelHead0(Bin2Hex)
End Function

' 用途：将二进制转化为八进制
Public Function Bin2Oct(ByVal BinCode As String) As String
Dim i As Integer, l As Integer
l = Len(BinCode) Mod 3
BinCode = String(3 - l, "0") & BinCode
For i = 1 To Len(BinCode) Step 3
Bin2Oct = Bin2Oct & (InStr("000;001;010;011;100;101;110;111;", Mid(BinCode, i, 3)) - 1) / 4
Next
Call DelHead0(Bin2Oct)
End Function

' 用途：将八进制转化为十六进制
Public Function Oct2Hex(ByVal OctStr As String) As String
Oct2Hex = Bin2Hex(Oct2Bin(OctStr))
Call DelHead0(Oct2Hex)
End Function

' 用途：将十六进制转化为八进制
Public Function Hex2Oct(ByVal HexStr As String) As String
Hex2Oct = Bin2Oct(Hex2Bin(HexStr))
Call DelHead0(Hex2Oct)
End Function
' 用途：去掉字符串的前导0
Public Sub DelHead0(InputStr As String)
Dim i As Integer
For i = 1 To Len(InputStr)
If Left(InputStr, 1) = "0" Then
InputStr = Mid(InputStr, i + 1)
Else: Exit Sub
End If
Next
End Sub

十进制 与其他进制的转换最难 请问谁有好的方法？？？？

[此贴子已经被作者于2007-8-25 15:56:28编辑过]

这是multiple1902共享出来的 枕善居 里的代码 挺好


' 用途：将十进制转化为二进制
' 输入：Dec(十进制数)
' 输入数据类型：Long
' 输出：DEC_to_BIN(二进制数)
' 输出数据类型：String
' 输入的最大数为2147483647,输出最大数为1111111111111111111111111111111(31个1)
Public Function DEC_to_BIN(Dec As Long) As String
DEC_to_BIN = ""
Do While Dec > 0
DEC_to_BIN = Dec Mod 2 & DEC_to_BIN
Dec = Dec \ 2
Loop
End Function

' 用途：将二进制转化为十进制
' 输入：Bin(二进制数)
' 输入数据类型：String
' 输出：BIN_to_DEC(十进制数)
' 输出数据类型：Long
' 输入的最大数为1111111111111111111111111111111(31个1),输出最大数为2147483647
Public Function BIN_to_DEC(ByVal Bin As String) As Long
Dim i As Long
For i = 1 To Len(Bin)
BIN_to_DEC = BIN_to_DEC * 2 + Val(Mid(Bin, i, 1))
Next i
End Function

' 用途：将十六进制转化为二进制
' 输入：Hex(十六进制数)
' 输入数据类型：String
' 输出：HEX_to_BIN(二进制数)
' 输出数据类型：String
' 输入的最大数为2147483647个字符
Public Function HEX_to_BIN(ByVal Hex As String) As String
Dim i As Long
Dim B As String

Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, i, 1)
Case "0": B = B & "0000"
Case "1": B = B & "0001"
Case "2": B = B & "0010"
Case "3": B = B & "0011"
Case "4": B = B & "0100"
Case "5": B = B & "0101"
Case "6": B = B & "0110"
Case "7": B = B & "0111"
Case "8": B = B & "1000"
Case "9": B = B & "1001"
Case "A": B = B & "1010"
Case "B": B = B & "1011"
Case "C": B = B & "1100"
Case "D": B = B & "1101"
Case "E": B = B & "1110"
Case "F": B = B & "1111"
End Select
Next i
While Left(B, 1) = "0"
B = Right(B, Len(B) - 1)
Wend
HEX_to_BIN = B
End Function

' 用途：将二进制转化为十六进制
' 输入：Bin(二进制数)
' 输入数据类型：String
' 输出：BIN_to_HEX(十六进制数)
' 输出数据类型：String
' 输入的最大数为2147483647个字符
Public Function BIN_to_HEX(ByVal Bin As String) As String
Dim i As Long
Dim H As String
If Len(Bin) Mod 4 <> 0 Then
Bin = String(4 - Len(Bin) Mod 4, "0") & Bin
End If

For i = 1 To Len(Bin) Step 4
Select Case Mid(Bin, i, 4)
Case "0000": H = H & "0"
Case "0001": H = H & "1"
Case "0010": H = H & "2"
Case "0011": H = H & "3"
Case "0100": H = H & "4"
Case "0101": H = H & "5"
Case "0110": H = H & "6"
Case "0111": H = H & "7"
Case "1000": H = H & "8"
Case "1001": H = H & "9"
Case "1010": H = H & "A"
Case "1011": H = H & "B"
Case "1100": H = H & "C"
Case "1101": H = H & "D"
Case "1110": H = H & "E"
Case "1111": H = H & "F"
End Select
Next i
While Left(H, 1) = "0"
H = Right(H, Len(H) - 1)
Wend
BIN_to_HEX = H
End Function

' 用途：将十六进制转化为十进制
' 输入：Hex(十六进制数)
' 输入数据类型：String
' 输出：HEX_to_DEC(十进制数)
' 输出数据类型：Long
' 输入的最大数为7FFFFFFF,输出的最大数为2147483647
Public Function HEX_to_DEC(ByVal Hex As String) As Long
Dim i As Long
Dim B As Long

Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, Len(Hex) - i + 1, 1)
Case "0": B = B + 16 ^ (i - 1) * 0
Case "1": B = B + 16 ^ (i - 1) * 1
Case "2": B = B + 16 ^ (i - 1) * 2
Case "3": B = B + 16 ^ (i - 1) * 3
Case "4": B = B + 16 ^ (i - 1) * 4
Case "5": B = B + 16 ^ (i - 1) * 5
Case "6": B = B + 16 ^ (i - 1) * 6
Case "7": B = B + 16 ^ (i - 1) * 7
Case "8": B = B + 16 ^ (i - 1) * 8
Case "9": B = B + 16 ^ (i - 1) * 9
Case "A": B = B + 16 ^ (i - 1) * 10
Case "B": B = B + 16 ^ (i - 1) * 11
Case "C": B = B + 16 ^ (i - 1) * 12
Case "D": B = B + 16 ^ (i - 1) * 13
Case "E": B = B + 16 ^ (i - 1) * 14
Case "F": B = B + 16 ^ (i - 1) * 15
End Select
Next i
HEX_to_DEC = B
End Function
' 用途：将十进制转化为十六进制
' 输入：Dec(十进制数)
' 输入数据类型：Long
' 输出：DEC_to_HEX(十六进制数)
' 输出数据类型：String
' 输入的最大数为2147483647,输出最大数为7FFFFFFF
Public Function DEC_to_HEX(Dec As Long) As String
Dim a As String
DEC_to_HEX = ""
Do While Dec > 0
a = CStr(Dec Mod 16)
Select Case a
Case "10": a = "A"
Case "11": a = "B"
Case "12": a = "C"
Case "13": a = "D"
Case "14": a = "E"
Case "15": a = "F"
End Select
DEC_to_HEX = a & DEC_to_HEX
Dec = Dec \ 16
Loop
End Function

' 用途：将十进制转化为八进制
' 输入：Dec(十进制数)
' 输入数据类型：Long
' 输出：DEC_to_OCT(八进制数)
' 输出数据类型：String
' 输入的最大数为2147483647,输出最大数为17777777777
Public Function DEC_to_OCT(Dec As Long) As String
DEC_to_OCT = ""
Do While Dec > 0
DEC_to_OCT = Dec Mod 8 & DEC_to_OCT
Dec = Dec \ 8
Loop
End Function

' 用途：将八进制转化为十进制
' 输入：Oct(八进制数)
' 输入数据类型：String
' 输出：OCT_to_DEC(十进制数)
' 输出数据类型：Long
' 输入的最大数为17777777777,输出的最大数为2147483647
Public Function OCT_to_DEC(ByVal Oct As String) As Long
Dim i As Long
Dim B As Long

For i = 1 To Len(Oct)
Select Case Mid(Oct, Len(Oct) - i + 1, 1)
Case "0": B = B + 8 ^ (i - 1) * 0
Case "1": B = B + 8 ^ (i - 1) * 1
Case "2": B = B + 8 ^ (i - 1) * 2
Case "3": B = B + 8 ^ (i - 1) * 3
Case "4": B = B + 8 ^ (i - 1) * 4
Case "5": B = B + 8 ^ (i - 1) * 5
Case "6": B = B + 8 ^ (i - 1) * 6
Case "7": B = B + 8 ^ (i - 1) * 7
End Select
Next i
OCT_to_DEC = B
End Function

' 用途：将二进制转化为八进制
' 输入：Bin(二进制数)
' 输入数据类型：String
' 输出：BIN_to_OCT(八进制数)
' 输出数据类型：String
' 输入的最大数为2147483647个字符
Public Function BIN_to_OCT(ByVal Bin As String) As String
Dim i As Long
Dim H As String
If Len(Bin) Mod 3 <> 0 Then
Bin = String(3 - Len(Bin) Mod 3, "0") & Bin
End If

For i = 1 To Len(Bin) Step 3
Select Case Mid(Bin, i, 3)
Case "000": H = H & "0"
Case "001": H = H & "1"
Case "010": H = H & "2"
Case "011": H = H & "3"
Case "100": H = H & "4"
Case "101": H = H & "5"
Case "110": H = H & "6"
Case "111": H = H & "7"
End Select
Next i
While Left(H, 1) = "0"
H = Right(H, Len(H) - 1)
Wend
BIN_to_OCT = H
End Function

' 用途：将八进制转化为二进制
' 输入：Oct(八进制数)
' 输入数据类型：String
' 输出：OCT_to_BIN(二进制数)
' 输出数据类型：String
' 输入的最大数为2147483647个字符
Public Function OCT_to_BIN(ByVal Oct As String) As String
Dim i As Long
Dim B As String

For i = 1 To Len(Oct)
Select Case Mid(Oct, i, 1)
Case "0": B = B & "000"
Case "1": B = B & "001"
Case "2": B = B & "010"
Case "3": B = B & "011"
Case "4": B = B & "100"
Case "5": B = B & "101"
Case "6": B = B & "110"
Case "7": B = B & "111"
End Select
Next i
While Left(B, 1) = "0"
B = Right(B, Len(B) - 1)
Wend
OCT_to_BIN = B
End Function

' 用途：将八进制转化为十六进制
' 输入：Oct(八进制数)
' 输入数据类型：String
' 输出：OCT_to_HEX(十六进制数)
' 输出数据类型：String
' 输入的最大数为2147483647个字符
Public Function OCT_to_HEX(ByVal Oct As String) As String
Dim Bin As String
Bin = OCT_to_BIN(Oct)
OCT_to_HEX = BIN_to_HEX(Bin)
End Function

' 用途：将十六进制转化为八进制
' 输入：Hex(十六进制数)
' 输入数据类型：String
' 输出：HEX_to_OCT(八进制数)
' 输出数据类型：String
' 输入的最大数为2147483647个字符
Public Function HEX_to_OCT(ByVal Hex As String) As String
Dim Bin As String
Hex = UCase(Hex)
Bin = HEX_to_BIN(Hex)
HEX_to_OCT = BIN_to_OCT(Bin)
End Function

VB自带函数：
十进制转八进制：Oct(num)
十六进制转八进制：oct("&H" & num)
十进制转十六进制：hex(num)
八进制转十六进制：hex("&O" & num)

十六进制转换为十进制
Dim str As String
str = Text2.Text
Text10.Text = CLng("&H" & str)

我的 请指教
'//Hex to Bin By XR.Mao
Public Function Hex2Bin2(ByVal HexStr As String) As String
Dim BinArray( &HF) As String
Dim lngStrLen As Long
lngStrLen = Len(HexStr)
BinArray( &H0) = "0000": BinArray( &H1) = "0001": BinArray( &H2) = "0010": BinArray( &H3) = "0011"
BinArray( &H4) = "0100": BinArray( &H5) = "0101": BinArray( &H6) = "0110": BinArray( &H7) = "0111"
BinArray( &H8) = "1000": BinArray( &H9) = "1001": BinArray( &HA) = "1010": BinArray( &HB) = "1011"
BinArray( &HC) = "1100": BinArray( &HD) = "1101": BinArray( &HE) = "1110": BinArray( &HF) = "1111"
For i = 1 To lngStrLen
Hex2Bin2 = Hex2Bin2 & BinArray(Val("&H" & Mid(HexStr, i, 1)))
Next
Call ClearBinHead0(Hex2Bin2)
End Function

'//Bin to Hex By XR.Mao
Public Function Bin2Hex2(ByVal BinStr As String) As String
Dim HexArray(1111) As String
Dim lngStrLen As Long
'Dim Index As Long
lngStrLen = Len(BinStr)
HexArray(Val("0000")) = "0": HexArray(Val("0001")) = "1": HexArray(Val("0010")) = "2": HexArray(Val("0011")) = "3"
HexArray(Val("0100")) = "4": HexArray(Val("0101")) = "5": HexArray(Val("0110")) = "6": HexArray(Val("0111")) = "7"
HexArray(Val("1000")) = "8": HexArray(Val("1001")) = "9": HexArray(Val("1010")) = "A": HexArray(Val("1011")) = "B"
HexArray(Val("1100")) = "C": HexArray(Val("1101")) = "D": HexArray(Val("1110")) = "E": HexArray(Val("1111")) = "F"
For i = lngStrLen To 1 Step - 4
If i - 3 > 0 Then
'Index = Val(Mid(BinStr, i - 3, 4))
Bin2Hex2 = HexArray(Val(Mid(BinStr, i - 3, 4))) & Bin2Hex2
Else
'Index = Val(Mid(BinStr, 1, (lngStrLen Mod 4)))
Bin2Hex2 = HexArray(Val(Mid(BinStr, 1, (lngStrLen Mod 4)))) & Bin2Hex2
End If
'Bin2Hex2 = HexArray(Index) & Bin2Hex2
Next
End Function

'//Oct to Bin By XR.Mao
Public Function Oct2Bin2(ByVal OctStr As String) As String
Dim BinArray( &HF) As String
Dim lngStrLen As Long
lngStrLen = Len(OctStr)
BinArray( &O0) = "000": BinArray( &O1) = "001": BinArray( &O2) = "010": BinArray( &O3) = "011"
BinArray( &O4) = "100": BinArray( &O5) = "101": BinArray( &O6) = "110": BinArray( &O7) = "111"
For i = 1 To lngStrLen
Oct2Bin2 = Oct2Bin2 & BinArray(Val("&H" & Mid(OctStr, i, 1)))
Next
Call ClearBinHead0(Oct2Bin2)
End Function

'//Bin to Ocx By XR.Mao
Public Function Bin2Oct2(ByVal BinStr As String) As String
Dim OctArray(111) As String
Dim lngStrLen As Long
'Dim Index As Long
lngStrLen = Len(BinStr)
OctArray(Val("000")) = "0": OctArray(Val("001")) = "1": OctArray(Val("010")) = "2": OctArray(Val("011")) = "3"
OctArray(Val("100")) = "4": OctArray(Val("101")) = "5": OctArray(Val("110")) = "6": OctArray(Val("111")) = "7"
For i = lngStrLen To 1 Step - 3
If i - 2 > 0 Then
'Index = Val(Mid(BinStr, i - 3, 4))
Bin2Oct2 = OctArray(Val(Mid(BinStr, i - 2, 3))) & Bin2Oct2
Else
'Index = Val(Mid(BinStr, 1, (lngStrLen Mod 4)))
Bin2Oct2 = OctArray(Val(Mid(BinStr, 1, (lngStrLen Mod 3)))) & Bin2Oct2
End If
'Bin2Ocx2 = OctArray(Index) & Bin2Oct2
Next
End Function

'//Hex to Oct By XR.Mao
Public Function Hex2Oct2(ByVal HexStr As String) As String
Hex2Oct2 = Bin2Oct2(Hex2Bin2(HexStr))
End Function

'//Oct to Hex By XR.Mao
Public Function Oct2Hex2(ByVal OctStr As String) As String
Oct2Hex2 = Bin2Hex2(Oct2Bin2(OctStr))
End Function

'//Clear '0' head of the BinStr By XR.Mao
Public Sub ClearBinHead0(ByRef BinStr As String)
Dim i As Integer
For i = 1 To Len(BinStr)
If Left(BinStr, 1) = "0" Then
BinStr = Mid(BinStr, 2)
Else
Exit Sub
End If
Next
End Sub

代码由Slore高亮于 2007-8-25 18:42

[此贴子已经被slore于2007-8-25 18:44:59编辑过]

这篇文章好的很,看完就对进制表示完全OK 转自 百度百科 作者 宋静宇

在高速发展的现代社会,计算机浩浩荡荡地成为了人们生活中不可缺少的一部分,帮助人们解决通信,联络,互动等各方面的问题.今天我就给大家讲讲与计算机有关的“进制转换”问题.

我们以(25.625)(十)为例讲解一下进制之间的转化问题
说明:小数部份的转化计算机二级是不考的,有兴趣的人可以看一看
1. 十 -----> 二

(25.625)(十)
整数部分:
25/2=12......1
12/2=6 ......0
6/2=3 ......0
3/2=1 ......1
1/2=0 ......1
然后我们将余数按从下往上的顺序书写就是:11001,那么这个11001就是十进制25的二进制形式

小数部分:
0.625*2=1.25
0.25 *2=0.5
0.5 *2=1.0
然后我们将整数部分按从上往下的顺序书写就是:101,那么这个101就是十进制0.625的二进制形式

所以:(25.625)(十)=(11001.101)(二)

2. 二 ----> 十

(11001.101)(二)
整数部分: 下面的出现的2(x)表示的是2的x次方的意思
1*2(4)+1*2(3)+0*2(2)+0*2(1)+1*2(0)=25
小数部分:
1*2(-1)+0*2(-2)+1*2(-3)=0.625
所以:(11001.101)(二)=(25.625)(十)

3. 十 ----> 八

(25.625)(十)
整数部分:
25/8=3......1
3/8 =0......3
然后我们将余数按从下往上的顺序书写就是:31,那么这个31就是十进制25的八进制形式

小数部分:
0.625*8=5
然后我们将整数部分按从上往下的顺序书写就是:5,那么这个5就是十进制0.625的八进制形式

所以:(25.625)(十)=(31.5)(八)

4. 八 ----> 十
(31.5)(八)
整数部分:
3*8(1)+1*8(0)=25
小数部分:
5*8(-1)=0.625
所以(31.5)(八)=(25.625)(十)

5. 十 ----> 十六
(25.625)(十)
整数部分:
25/16=1......9
1/16 =0......1
然后我们将余数按从下往上的顺序书写就是:19,那么这个19就是十进制25的十六进制形式
小数部分:
0.625*16=10(即十六进制的A或a)
然后我们将整数部分按从上往下的顺序书写就是:A,那么这个A就是十进制0.625的十六进制形式
所以:(25.625)(十)=(19.A)(十六)

6. 十六----> 十
(19.A)(十六)
整数部分:
1*16(1)+9*16(0)=25
小数部分:
10*16(-1)=0.625
所以(19.A)(十六)=(25.625)(十)

如何将带小数的二进制与八进制、十六进制数之间的转化问题

我们以(11001.101)(二)为例讲解一下进制之间的转化问题

1. 二 ----> 八
(11001.101)(二)
整数部分: 从后往前每三位一组,缺位处有0填补,然后按十进制方法进行转化, 则有:
001=1
011=3
然后我们将结果按从下往上的顺序书写就是:31,那么这个31就是二进制11001的八进制形式

小数部分: 从前往后每三位一组,缺位处有0填补,然后按十进制方法进行转化, 则有:
101=5
然后我们将结果部分按从上往下的顺序书写就是:5,那么这个5就是二进制0.625的八进制形式
所以:(11001.101)(二)=(31.5)(八)

2. 八 ----> 二
(31.5)(八)
整数部分:从后往前每一位按十进制转化方式转化为三位二进制数,缺位处用0补充 则有:
1---->1---->001
3---->101
然后我们将结果按从下往上的顺序书写就是:11001,那么这个11001就是八进制31的二进制形式
说明,关于十进制的转化方式我这里就不再说了,上一篇文章我已经讲解了!

小数部分:从前往后每一位按十进制转化方式转化为三位二进制数,缺位处用0补充 则有:
5---->101
然后我们将结果按从下往上的顺序书写就是:101,那么这个101就是八进制5的二进制形式
所以:(31.5)(八)=(11001.101)(二)

3. 十六 ----> 二
(19.A)(十六)
整数部分:从后往前每位按十进制转换成四位二进制数,缺位处用0补充 则有:
9---->1001
1---->0001(相当于1)
则结果为00011001或者11001
小数部分:从前往后每位按十进制转换成四位二进制数,缺位处用0补充 则有:
A(即10)---->1010
所以:(19.A)(十六)=(11001.1010)(二)=(11001.101)(二)

4. 二 ----> 十六
(11001.101)(二)
整数部分:从后往前每四位按十进制转化方式转化为一位数,缺位处用0补充 则有:
1001---->9
0001---->1
则结果为19
小数部分:从前往后每四位按十进制转化方式转化为一位数,缺位处用0补充 则有:
1010---->10---->A
则结果为A
所以:(11001.101)(二)=(19.A)(十六)

最近有些朋友提了这样的问题“0.8的十六进制是多少?”
我想在我的空间里已经有了详细的讲解,为什么他还要问这样的问题那
于是我就动手算了一下,发现0.8、0.6、0.2... ...一些数字在进制之间的转化
过程中确实存在麻烦.

就比如“0.8的十六进制”吧!
无论你怎么乘以16,它的余数总也乘不尽,总是余8
这可怎么办啊,我也没折了
第二天,我请教了我的老师才知道,原来这么简单啊!

具体方法如下:
0.8*16=12.8
0.8*16=12.8
.
.
.
.
.
取每一个结果的整数部分为12既十六进制的C
如果题中要求精确到小数点后3位那结果就是0.CCC
如果题中要求精确到小数点后4位那结果就是0.CCCC