VBAでASCIIコード(漢字)の逆変換を行うコードを作成して下さい。


例:
hogehoge 清水 愛 → hogehoge 清水 愛

よろしくお願いします!

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2010/10/07 21:29:25
  • 終了:2010/10/09 13:33:39

ベストアンサー

id:Silvanus No.2

Silvanus回答回数174ベストアンサー獲得回数672010/10/08 11:21:56

ポイント100pt

元の文字列がどの様な形(コード、変数型)で提供されるのかが判りませんので

これがご希望の答えになっているのか判りませんが、

元の文字列がVBAのString型変数に格納されているor定数になっているとした場合、

次のマクロで変換出来ます。いつもの如く力業です。

きっともっとスマートな方法があると思いますが、私の能力・知識範囲外です。

Option Explicit

Sub Hatena_ReoReo7_101007_01()

Debug.Print strCnvUcCN("hogehoge 清水 愛xxx�yyy&#xzzz")

End Sub

Function strCnvUcCN(strSrc As String) As String

Dim strCnv As String

Dim intPosP As Integer

Dim intPosS As Integer

Do

intPosP = InStr(1, strSrc, "&#x")

If intPosP Then

intPosS = InStr(intPosP + 3, strSrc, ";")

If (intPosS > 0) And (intPosS - intPosP < 8) Then

strCnv = strCnv & Left(strSrc, intPosP - 1) _

& ChrW(lngHexStr2Lng(Mid(strSrc, intPosP + 3, intPosS - intPosP - 3)))

strSrc = Mid(strSrc, intPosS + 1)

Else

strCnv = strCnv & Left(strSrc, intPosP + 2)

strSrc = Mid(strSrc, intPosP + 3)

End If

Else

strCnv = strCnv & strSrc

strSrc = ""

End If

Loop Until Len(strSrc) = 0

strCnvUcCN = strCnv

End Function

Function lngHexStr2Lng(strHex As String) As Long

Dim lngValT As Long

Dim lngValD As Long

Dim iCount1 As Integer

strHex = StrConv(strHex, vbUpperCase)

For iCount1 = 1 To Len(strHex)

lngValD = InStr(1, "0123456789ABCDEF", Mid(strHex, iCount1, 1)) - 1

If lngValD >= 0 Then

lngValT = lngValT + lngValD * 16 ^ (Len(strHex) - iCount1)

Else

lngHexStr2Lng = -1

Exit Function

End If

Next

lngHexStr2Lng = lngValT

End Function

id:ReoReo7

できています!!

いろいろなデータ(HTMLドキュメント中に出てくる<title></title>タグで囲まれた日本語アドレス)の変換を試してみましたが、見事に変換できています。

プログラムをシンプルに標準モジュールに貼り付けるだけでできたので感激しています。ありがとうございます!

2010/10/09 13:29:49

その他の回答(2件)

id:deflation No.1

deflation回答回数1036ベストアンサー獲得回数1262010/10/07 21:59:12

id:ReoReo7

ありがとうございます。プログラムに困った際の参考にさせて頂こうと思います。

2010/10/09 13:25:43
id:Silvanus No.2

Silvanus回答回数174ベストアンサー獲得回数672010/10/08 11:21:56ここでベストアンサー

ポイント100pt

元の文字列がどの様な形(コード、変数型)で提供されるのかが判りませんので

これがご希望の答えになっているのか判りませんが、

元の文字列がVBAのString型変数に格納されているor定数になっているとした場合、

次のマクロで変換出来ます。いつもの如く力業です。

きっともっとスマートな方法があると思いますが、私の能力・知識範囲外です。

Option Explicit

Sub Hatena_ReoReo7_101007_01()

Debug.Print strCnvUcCN("hogehoge 清水 愛xxx&#x611BAAA;yyy&#xzzz")

End Sub

Function strCnvUcCN(strSrc As String) As String

Dim strCnv As String

Dim intPosP As Integer

Dim intPosS As Integer

Do

intPosP = InStr(1, strSrc, "&#x")

If intPosP Then

intPosS = InStr(intPosP + 3, strSrc, ";")

If (intPosS > 0) And (intPosS - intPosP < 8) Then

strCnv = strCnv & Left(strSrc, intPosP - 1) _

& ChrW(lngHexStr2Lng(Mid(strSrc, intPosP + 3, intPosS - intPosP - 3)))

strSrc = Mid(strSrc, intPosS + 1)

Else

strCnv = strCnv & Left(strSrc, intPosP + 2)

strSrc = Mid(strSrc, intPosP + 3)

End If

Else

strCnv = strCnv & strSrc

strSrc = ""

End If

Loop Until Len(strSrc) = 0

strCnvUcCN = strCnv

End Function

Function lngHexStr2Lng(strHex As String) As Long

Dim lngValT As Long

Dim lngValD As Long

Dim iCount1 As Integer

strHex = StrConv(strHex, vbUpperCase)

For iCount1 = 1 To Len(strHex)

lngValD = InStr(1, "0123456789ABCDEF", Mid(strHex, iCount1, 1)) - 1

If lngValD >= 0 Then

lngValT = lngValT + lngValD * 16 ^ (Len(strHex) - iCount1)

Else

lngHexStr2Lng = -1

Exit Function

End If

Next

lngHexStr2Lng = lngValT

End Function

id:ReoReo7

できています!!

いろいろなデータ(HTMLドキュメント中に出てくる<title></title>タグで囲まれた日本語アドレス)の変換を試してみましたが、見事に変換できています。

プログラムをシンプルに標準モジュールに貼り付けるだけでできたので感激しています。ありがとうございます!

2010/10/09 13:29:49
id:a-kuma3 No.3

a-kuma3回答回数4487ベストアンサー獲得回数18562010/10/08 12:10:36

ポイント70pt

MSXML を使ってみるのはどうかな?


s = "hogehoge 清水 愛"

Dim xmlDoc As New MSXML2.DOMDocument

xmlDoc.LoadXML ("<test>" & s & "</test>")

MsgBox xmlDoc.FirstChild.Text


参照設定で、Microsoft XML のどれかを設定しておいてね。

id:ReoReo7

これもできています!参照設定をすれば、シンプルなプログラムで可能なのですね~。

今回はすごく助かりました。本当にありがとうございます。

2010/10/09 13:32:32

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません