高分求一算法(关于汉字与区位码的转换)

Question

Private Sub Command1_Click()
    Dim strOutput As String
    Dim intQu As Integer
    Dim intWei As Integer
    Dim strTest As String
    Dim strAscii As String
    
    strTest = "李"
    strAscii = CStr(Hex(Asc(strTest)))
    intQu = CInt("&H" & Left(strAscii, 2)) - 160
    intWei = CInt("&H" & Right(strAscii, 2)) - 160
    'strOutput = StrConv(strOutput, vbFromUnicode)
    strOutput = ChrB(&HA0 + intQu) & ChrB(&HA0 + intWei)
    strOutput = StrConv(strOutput, vbUnicode)
    MsgBox strOutput '显示‘李’字
End Sub

Answer 1

参考一下这些代码：返回汉字字符串汉字拼音的第一个字母一类模块中： 
Private  Const  IME_ESC_MAX_KEY  =  &H1005 
Private  Const  IME_ESC_IME_NAME  =  &H1006 
Private  Const  GCL_REVERSECONVERSION  =  &H2 Private  Type  CANDIDATELIST 
dwSize  As  Long 
dwStyle  As  Long 
dwCount  As  Long 
dwSelection  As  Long 
dwPageStart  As  Long 
dwPageSize  As  Long 
dwOffset(1)  As  Long 
End  Type Private  Declare  Function  GetKeyboardLayoutList  Lib  "user32"  (ByVal  nBuff  As  Long,  lpList  As  Long)  As  Long 
Private  Declare  Function  ImmEscape  Lib  "imm32.dll"  Alias  "ImmEscapeA"  (ByVal  hkl  As  Long,  ByVal  himc  As  Long,  ByVal  un  As  Long,  lpv  As  Any)  As  Long 
Private  Declare  Function  ImmGetConversionList  Lib  "imm32.dll"  Alias  "ImmGetConversionListA"  (ByVal  hkl  As  Long,  ByVal  himc  As  Long,  ByVal  lpsz  As  String,  lpCandidateList  As  Any,  ByVal  dwBufLen  As  Long,  ByVal  uFlag  As  Long)  As  Long 
'Private  Declare  Function  ImmGetConversionList  Lib  "imm32.dll"  Alias  "ImmGetConversionListA"  (ByVal  hkl  As  Long,  ByVal  himc  As  Long,  ByVal  lpsz  As  String,  lpCandidateList  As  CANDIDATELIST,  ByVal  dwBufLen  As  Long,  ByVal  uFlag  As  Long)  As  Long 
Private  Declare  Function  IsDBCSLeadByte  Lib  "kernel32"  (ByVal  bTestChar  As  Byte)  As  Long Private  Const  NUM_OF_BUFFERS  =  40 
Private  Const  MSPY  =  "微软拼音输入法" 
Dim  imeHandle(1  To  NUM_OF_BUFFERS)  As  Long 
Dim  imeName(1  To  NUM_OF_BUFFERS)  As  String Dim  mlMSPYIndex  As  Long 
Dim  imeCount  As  Long Private  Sub  Init() 
Dim  i  As  Long 
Dim  sName  As  String mlMSPYIndex  =  0 
imeCount  =  GetKeyboardLayoutList(NUM_OF_BUFFERS,  imeHandle(1)) 
If  imeCount  Then 
For  i  =  1  To  imeCount 
sName  =  String(255,  "  ") 
If  ImmEscape(imeHandle(i),  0,  IME_ESC_IME_NAME,  ByVal  sName)  Then 
If  sName  <>  ""  Then  sName  =  Left(sName,  InStr(sName,  vbNullChar)  -  1) 
imeName(i)  =  sName 
If  sName  =  MSPY  Then 
mlMSPYIndex  =  i 
End  If 
End  If 
Next  i 
End  If End  Sub Public  Property  Get  MSPYInstalled()  As  Boolean 
MSPYInstalled  =  IIf(mlMSPYIndex,  True,  False) 
End  Property Public  Property  Get  MSPYIndex()  As  Long 
MSPYIndex  =  mlMSPYIndex 
End  Property Public  Property  Get  Count()  As  Long 
Count  =  imeCount 
End  Property Public  Function  GetHandle(ByVal  lIndex  As  Long)  As  Long 
If  lIndex  >=  1  And  lIndex  <=  imeCount  Then 
GetHandle  =  imeHandle(lIndex) 
End  If 
End  Function Public  Function  GetName(ByVal  lIndex  As  Long)  As  String 
If  lIndex  >=  1  And  lIndex  <=  imeCount  Then 
GetName  =  imeName(lIndex) 
End  If 
End  Function 
       以上代码来自： 源代码数据库(SourceDataBase)
           当前版本： 1.0.535
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729返回汉字字符串汉字拼音的第一个字母二Public Function MSPYReverse(ByVal sString As String) As String
Dim lStrLen   As Long
Dim i   As Long
Dim sChar   As String
Dim bChar()   As ByteIf MSPYInstalled Then
lStrLen = Len(sString)
MSPYReverse = ""
If lStrLen Then
For i = 1 To lStrLen
sChar = Mid(sString, i, 1)
bChar = StrConv(sChar, vbFromUnicode)
If IsDBCSLeadByte(bChar(0)) Then
Dim lMaxKey   As Long
Dim lGCL   As LonglMaxKey = ImmEscape(imeHandle(mlMSPYIndex), 0, IME_ESC_MAX_KEY, Null)
If lMaxKey Then
Dim tCandi   As CANDIDATELIST
lGCL = ImmGetConversionList(imeHandle(mlMSPYIndex), 0, sChar, 0, 0, GCL_REVERSECONVERSION)
If lGCL > 0 Then
Dim bBuffer()   As Byte
Dim MaxKey   As Long
Dim sBuffer   As String
sBuffer = String(255, vbNullChar)
MaxKey = lMaxKey
lGCL = ImmGetConversionList(imeHandle(mlMSPYIndex), 0, sChar, ByVal sBuffer, lGCL, GCL_REVERSECONVERSION)
If lGCL > 0 Then
Dim bPY()   As Byte
Dim j   As LongbBuffer = StrConv(sBuffer, vbFromUnicode)ReDim bPY(MaxKey * 2 - 1)
For j = bBuffer(24) To bBuffer(24) + MaxKey * 2 - 1
bPY(j - bBuffer(24)) = bBuffer(j)
Next j
sChar = StrConv(bPY, vbUnicode)If InStr(sChar, vbNullChar) Then
sChar = Trim(Left(sChar, InStr(sChar, vbNullChar) - 1))
End If
sChar = Left(sChar, Len(sChar) - 1) & "  "
End If
End If
End If
End If
MSPYReverse = MSPYReverse & sChar
Next i
End If
Else
'替代方法
MSPYReverse = GetPYStr(sString)
End If
End FunctionPrivate Sub Class_Initialize()
Init
End SubPrivate Function GetPYChar(a1 As String) As String
Dim t1   As String
If Asc(a1) < 0 Then
t1 = Left(a1, 1)
If Asc(t1) < Asc("啊") Then
GetPYChar = "  "
Exit Function
End If
If Asc(t1) >= Asc("啊") And Asc(t1) < Asc("芭") Then
GetPYChar = "A"
Exit Function
End If
       以上代码来自： 源代码数据库(SourceDataBase)
           当前版本： 1.0.535
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729

Answer 2

返回汉字字符串汉字拼音的第一个字母三
If  Asc(t1)  >=  Asc("擦")  And  Asc(t1)  <  Asc("搭")  Then 
GetPYChar  =  "C" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("搭")  And  Asc(t1)  <  Asc("蛾")  Then 
GetPYChar  =  "D" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("蛾")  And  Asc(t1)  <  Asc("发")  Then 
GetPYChar  =  "E" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("发")  And  Asc(t1)  <  Asc("噶")  Then 
GetPYChar  =  "F" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("噶")  And  Asc(t1)  <  Asc("哈")  Then 
GetPYChar  =  "G" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("哈")  And  Asc(t1)  <  Asc("击")  Then 
GetPYChar  =  "H" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("击")  And  Asc(t1)  <  Asc("喀")  Then 
GetPYChar  =  "J" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("喀")  And  Asc(t1)  <  Asc("垃")  Then 
GetPYChar  =  "K" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("垃")  And  Asc(t1)  <  Asc("妈")  Then 
GetPYChar  =  "L" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("妈")  And  Asc(t1)  <  Asc("拿")  Then 
GetPYChar  =  "M" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("拿")  And  Asc(t1)  <  Asc("哦")  Then 
GetPYChar  =  "N" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("哦")  And  Asc(t1)  <  Asc("啪")  Then 
GetPYChar  =  "O" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("啪")  And  Asc(t1)  <  Asc("期")  Then 
GetPYChar  =  "P" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("期")  And  Asc(t1)  <  Asc("然")  Then 
GetPYChar  =  "Q" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("然")  And  Asc(t1)  <  Asc("撒")  Then 
GetPYChar  =  "R" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("撒")  And  Asc(t1)  <  Asc("塌")  Then 
GetPYChar  =  "S" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("塌")  And  Asc(t1)  <  Asc("挖")  Then 
GetPYChar  =  "T" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("挖")  And  Asc(t1)  <  Asc("昔")  Then 
GetPYChar  =  "W" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("昔")  And  Asc(t1)  <  Asc("压")  Then 
GetPYChar  =  "X" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("压")  And  Asc(t1)  <  Asc("匝")  Then 
GetPYChar  =  "Y" 
Exit  Function 
End  If 
If  Asc(t1)  >=  Asc("匝")  Then 
GetPYChar  =  "Z" 
Exit  Function 
End  If 
Else 
If  UCase(a1)  <=  "Z"  And  UCase(a1)  >=  "A"  Then 
GetPYChar  =  UCase(Left(a1,  1)) 
Else 
GetPYChar  =  "  " 
End  If 
End  If 
End  Function Private  Function  GetPYStr(ByVal  S  As  String)  As  String 
Dim  l  As  Long 
Dim  sOut  As  String If  S  <>  ""  Then 
For  l  =  1  To  Len(S) 
sOut  =  sOut  &  GetPYChar(Mid(S,  l,  1)) 
Next  l 
GetPYStr  =  sOut 
End  If 
End  Function 
  
工程1中 
Dim  aa  As  New  Class1 Private  Sub  Command1_Click() 
Text2.Text  =  aa.MSPYReverse(Text1.Text) 
End  Sub 
       以上代码来自： 源代码数据库(SourceDataBase)
           当前版本： 1.0.535
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729返回汉字字符串汉字拼音的第一个字母四'自定义函数，对任意输入的汉字，可以得到它的拼音的第一个字母
'函数入口为汉字串，返回值为该汉字的第一个字母
Public Function getHzPy(hzStr As String) As String
On Error Resume Next
'declare    variable
Dim myHzm   As Integer
Dim qm   As Integer
Dim wm   As Integer
Dim hznm   As String
If Len(hzStr) > 1 Then
        myHzm = Asc(Left(hzStr, 1))
Else
        myHzm = Asc(hzStr)
End If
If myHzm >= 0 And myHzm < 256 Then
        '字母
        getHzPy = hzStr
Else
        '汉字
        qm = (myHzm + 65536) \ 256              '取区码
        wm = (myHzm + 65536) Mod 256          '取位码
        '十进制到十六进制
        hznm = tento(qm, 16) & tento(wm, 16)
End If
If "B0A1" <= hznm And hznm <= "B0C4" Then
getHzPy = "A"
ElseIf "B0C5" <= hznm And hznm <= "B2C0" Then
getHzPy = "B"
ElseIf "B2C1" <= hznm And hznm <= "B4ED" Then
getHzPy = "C"
ElseIf "B4EE" <= hznm And hznm <= "B6E9" Then
getHzPy = "D"
ElseIf "B6EA" <= hznm And hznm <= "B7A1" Then
getHzPy = "E"
ElseIf "B7A2" <= hznm And hznm <= "B8C0" Then
getHzPy = "F"
ElseIf "B8C1" <= hznm And hznm <= "B9FD" Then
getHzPy = "G"
ElseIf "B9FE" <= hznm And hznm <= "BBF6" Then
getHzPy = "H"
ElseIf "BBF7" <= hznm And hznm <= "BFA5" Then
getHzPy = "J"
ElseIf "BFA6" <= hznm And hznm <= "C0AB" Then
getHzPy = "K"
ElseIf "C0AC" <= hznm And hznm <= "C2E7" Then
getHzPy = "L"
ElseIf "C2E8" <= hznm And hznm <= "C4C2" Then
getHzPy = "M"
ElseIf "C4C3" <= hznm And hznm <= "C5B5" Then
getHzPy = "N"
ElseIf "C5B6" <= hznm And hznm <= "C5BD" Then
getHzPy = "O"
ElseIf "C5BE" <= hznm And hznm <= "C6D9" Then
getHzPy = "P"
ElseIf "C6DA" <= hznm And hznm <= "C8BA" Then
getHzPy = "Q"
ElseIf "C8BB" <= hznm And hznm <= "C8F5" Then
getHzPy = "R"
ElseIf "C8F6" <= hznm And hznm <= "CBF9" Then
getHzPy = "S"
ElseIf "CBFA" <= hznm And hznm <= "CDD9" Then
getHzPy = "T"
ElseIf "CDDA" <= hznm And hznm <= "CEF3" Then
getHzPy = "W"
ElseIf "CEF4" <= hznm And hznm <= "D188" Then
getHzPy = "X"
ElseIf "D1B9" <= hznm And hznm <= "D4D0" Then
getHzPy = "Y"
ElseIf "D4D1" <= hznm And hznm <= "D7F9" Then
getHzPy = "Z"
Else
getHzPy = hznm
End If
End Function
'辅助函数，可以从十进制转换到任意进制
'//入口为十进制数，要转换的进制，返回为该进制数
Public Function tento(m As Integer, n As Integer) As String
Dim q   As Integer
Dim r   As Integer
        tento = ""
        Dim bStr   As String
        Do
        Call myDivide(m, n, q, r)
        If r > 9 Then
                bStr = Chr(55 + r)
        Else
                bStr = Str(r)
        End If
        tento = Trim(bStr) & tento
        m = q
        Loop While q <> 0
End Function'辅助过程，得到任意两个数的商和余数
Public Sub myDivide(num1 As Integer, num2 As Integer, q As Integer, r As Integer)
        If num2 = 0 Then
                MsgBox ("非法除数")
                Exit Sub
        End If
        If num1 / num2 >= 0 Then
                q = Int(num1 / num2)
        Else
                q = Int(num1 / num2) + 1
        End If
                r = num1 Mod num2
End Sub
       以上代码来自： 源代码数据库(SourceDataBase)
           当前版本： 1.0.535
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729

Answer 3

楼上的，你那个好像是取得unicode代码把！unicode和区位码一样？

Answer 4

一个汉字的GB码实际是一个16位无符号整数。它的范围是0xa1a1-0xf7fe
而区位码分为87区，每区94字。
用GB码减去0xa0a0，就是区位码了。

Answer 5

to  NowCan(能量、激情、雨水、彩虹——雷雨云) :
    能讲详细点吗？我对这方面一无所知，先谢了！！

Answer 6

你可以通过输入法生成器，逆转换，得到任何一个windows标准输入法的汉字跟编码的转换表，包括区位，然后编程根据对应表来查编码当然，象区位这种完全有规律的编码，当然首推采用NowCan(能量、激情、雨水、彩虹——雷雨云) 的方法
~我只是提供一点参考~

Answer 7

Dim bQW()       As Byte
    Dim iQh         As Long
    Dim iWh         As Long
    Dim StrPara     As String
    StrPara = Mid(StrPara, 1, 1)
    If Hex(Asc(StrPara)) < &H80 Then
        bQW = StrConv(StrPara, vbUnicode)
        iWh = bQW(0)
        iQh = bQW(1)
    Else
        bQW = StrConv(StrPara, vbFromUnicode)
        iQh = bQW(0) - &HA0
        iWh = bQW(1) - &HA0
    End If
01 01 | 　 、 。 · ˉ ˇ ¨ 〃 々 — ～ ‖ … ‘ ’ “ 
 01 17 | ” 〔 〕 〈 〉 《 》 「 」 『 』 〖 〗 【 】 ± 
 01 33 | × ÷ ∶ ∧ ∨ ∑ ∏ ∪ ∩ ∈ ∷ √ ⊥ ∥ ∠ ⌒ 
 01 49 | ⊙ ∫ ∮ ≡ ≌ ≈ ∽ ∝ ≠ ≮ ≯ ≤ ≥ ∞ ∵ ∴ 
 01 65 | ♂ ♀ ° ′ ″ ℃ ＄ ¤ ￠ ￡ ‰ § № ☆ ★ ○ 
 01 81 | ● ◎ ◇ ◆ □ ■ △ ▲ ※ → ← ↑ ↓ 〓  02 01 | ⅰ ⅱ ⅲ ⅳ ⅴ ⅵ ⅶ ⅷ ⅸ ⅹ       
 02 17 | ⒈ ⒉ ⒊ ⒋ ⒌ ⒍ ⒎ ⒏ ⒐ ⒑ ⒒ ⒓ ⒔ ⒕ ⒖ ⒗ 
 02 33 | ⒘ ⒙ ⒚ ⒛ ⑴ ⑵ ⑶ ⑷ ⑸ ⑹ ⑺ ⑻ ⑼ ⑽ ⑾ ⑿ 
 02 49 | ⒀ ⒁ ⒂ ⒃ ⒄ ⒅ ⒆ ⒇ ① ② ③ ④ ⑤ ⑥ ⑦ ⑧ 
 02 65 | ⑨ ⑩   ㈠ ㈡ ㈢ ㈣ ㈤ ㈥ ㈦ ㈧ ㈨ ㈩   
 02 81 | Ⅰ Ⅱ Ⅲ Ⅳ Ⅴ Ⅵ Ⅶ Ⅷ Ⅸ Ⅹ Ⅺ Ⅻ    03 01 | ！ ＂ ＃ ￥ ％ ＆ ＇ （ ） ＊ ＋ ， － ． ／ ０ 
 03 17 | １ ２ ３ ４ ５ ６ ７ ８ ９ ： ； ＜ ＝ ＞ ？ ＠ 
 03 33 | Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ Ｏ Ｐ 
 03 49 | Ｑ Ｒ Ｓ Ｔ Ｕ Ｖ Ｗ Ｘ Ｙ Ｚ ［ ＼ ］ ＾ ＿ ｀ 
 03 65 | ａ ｂ ｃ ｄ ｅ ｆ ｇ ｈ ｉ ｊ ｋ ｌ ｍ ｎ ｏ ｐ 
 03 81 | ｑ ｒ ｓ ｔ ｕ ｖ ｗ ｘ ｙ ｚ ｛ ｜ ｝ ￣  04 01 | ぁ あ ぃ い ぅ う ぇ え ぉ お か が き ぎ く ぐ 
 04 17 | け げ こ ご さ ざ し じ す ず せ ぜ そ ぞ た だ 
 04 33 | ち ぢ っ つ づ て で と ど な に ぬ ね の は ば 
 04 49 | ぱ ひ び ぴ ふ ぶ ぷ へ べ ぺ ほ ぼ ぽ ま み む 
 04 65 | め も ゃ や ゅ ゆ ょ よ ら り る れ ろ ゎ わ ゐ 
 04 81 | ゑ を ん             05 01 | ァ ア ィ イ ゥ ウ ェ エ ォ オ カ ガ キ ギ ク グ 
 05 17 | ケ ゲ コ ゴ サ ザ シ ジ ス ズ セ ゼ ソ ゾ タ ダ 
 05 33 | チ ヂ ッ ツ ヅ テ デ ト ド ナ ニ ヌ ネ ノ ハ バ 
 05 49 | パ ヒ ビ ピ フ ブ プ ヘ ベ ペ ホ ボ ポ マ ミ ム 
 05 65 | メ モ ャ ヤ ュ ユ ョ ヨ ラ リ ル レ ロ ヮ ワ ヰ 
 05 81 | ヱ ヲ ン ヴ ヵ ヶ          06 01 | Α Β Γ Δ Ε Ζ Η Θ Ι Κ Λ Μ Ν Ξ Ο Π 
 06 17 | Ρ Σ Τ Υ Φ Χ Ψ Ω         
 06 33 | α β γ δ ε ζ η θ ι κ λ μ ν ξ ο π 
 06 49 | ρ σ τ υ φ χ ψ ω        ︵ 
 06 65 | ︶ ︹ ︺ ︿ ﹀ ︽ ︾ ﹁ ﹂ ﹃ ﹄   ︻ ︼ ︷ 
 06 81 | ︸ ︱  ︳ ︴           07 01 | А Б В Г Д Е Ё Ж З И Й К Л М Н О 
 07 17 | П Р С Т У Ф Х Ц Ч Ш Щ Ъ Ы Ь Э Ю 
 07 33 | Я                
 07 49 | а б в г д е ё ж з и й к л м н о 
 07 65 | п р с т у ф х ц ч ш щ ъ ы ь э ю 
 07 81 | я               08 01 | ā á ǎ à ē é ě è ī í ǐ ì ō ó ǒ ò 
 08 17 | ū ú ǔ ù ǖ ǘ ǚ ǜ ü ê ɑ  ń ň  ɡ 
 08 33 |     ㄅ ㄆ ㄇ ㄈ ㄉ ㄊ ㄋ ㄌ ㄍ ㄎ ㄏ ㄐ 
 08 49 | ㄑ ㄒ ㄓ ㄔ ㄕ ㄖ ㄗ ㄘ ㄙ ㄚ ㄛ ㄜ ㄝ ㄞ ㄟ ㄠ 
 08 65 | ㄡ ㄢ ㄣ ㄤ ㄥ ㄦ ㄧ ㄨ ㄩ        
 08 81 |                09 01 |    ─ ━ │ ┃ ┄ ┅ ┆ ┇ ┈ ┉ ┊ ┋ ┌ 
 09 17 | ┍ ┎ ┏ ┐ ┑ ┒ ┓ └ ┕ ┖ ┗ ┘ ┙ ┚ ┛ ├ 
 09 33 | ┝ ┞ ┟ ┠ ┡ ┢ ┣ ┤ ┥ ┦ ┧ ┨ ┩ ┪ ┫ ┬ 
 09 49 | ┭ ┮ ┯ ┰ ┱ ┲ ┳ ┴ ┵ ┶ ┷ ┸ ┹ ┺ ┻ ┼ 
 09 65 | ┽ ┾ ┿ ╀ ╁ ╂ ╃ ╄ ╅ ╆ ╇ ╈ ╉ ╊ ╋  
 09 81 |

Answer 8

首先谢谢和位热心相助！！！来者有分，只要不灌水：）
 我试了一下　shawls(小山(坚持VB,学VB.net和C#)) 的方法 If Len(hzStr) > 1 Then
        myHzm = Asc(Left(hzStr, 1))
Else
        myHzm = Asc(hzStr)
End If
If myHzm >= 0 And myHzm < 256 Then
        '字母
        getHzPy = hzStr
Else
        '汉字
        qm = (myHzm + 65536) \ 256              '取区码
        wm = (myHzm + 65536) Mod 256          '取位码
        '十进制到十六进制
        hznm = tento(qm, 16) & tento(wm, 16)
End If
（详细过见楼上）
 可以得到一个汉字区位码，但我还是看不懂，一个汉字ASCII码和它的区位吗之间到底存在什么关系？我很菜哦:)
 另外几位朋友的方法我也会试下，找出一种简单且速度快的方法。