Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11209 / 13644 ツリー ←次へ | 前へ→

【17413】文字列を8ビットコードに簡単に変換したい HyperVTEC 04/8/28(土) 23:39 質問[未読]
【17419】Re:文字列を8ビットコードに簡単に変換した... Hirofumi 04/8/29(日) 1:11 回答[未読]
【17423】Re:文字列を8ビットコードに簡単に変換した... HyperVTEC 04/8/29(日) 9:25 質問[未読]
【17426】Re:文字列を8ビットコードに簡単に変換した... Hirofumi 04/8/29(日) 11:38 回答[未読]
【17425】Re:文字列を8ビットコードに簡単に変換した... ichinose 04/8/29(日) 10:58 発言[未読]
【17428】Re:文字列を8ビットコードに簡単に変換した... HyperVTEC 04/8/29(日) 11:56 質問[未読]
【17431】Re:文字列を8ビットコードに簡単に変換した... Hirofumi 04/8/29(日) 12:46 回答[未読]
【17433】Re:文字列を8ビットコードに簡単に変換した... HyperVTEC 04/8/29(日) 13:50 お礼[未読]
【17434】Re:文字列を8ビットコードに簡単に変換した... ichinose 04/8/29(日) 14:34 発言[未読]
【17435】Re:文字列を8ビットコードに簡単に変換した... HyperVTEC 04/8/29(日) 16:56 お礼[未読]
【17436】Re:文字列を8ビットコードに簡単に変換した... ichinose 04/8/29(日) 17:47 発言[未読]
【17437】Re:文字列を8ビットコードに簡単に変換した... HyperVTEC 04/8/29(日) 18:28 質問[未読]
【17438】Re:文字列を8ビットコードに簡単に変換した... ichinose 04/8/29(日) 18:39 発言[未読]
【17439】Re:文字列を8ビットコードに簡単に変換した... HyperVTEC 04/8/29(日) 19:00 お礼[未読]

【17413】文字列を8ビットコードに簡単に変換したい
質問  HyperVTEC  - 04/8/28(土) 23:39 -

引用なし
パスワード
   ExcelVBAで、textboxに入力した文字列をJIS8単位コードに変換するプログラムを作りたいのですが・・・

TextBox2 = Replace(TextBox1.Text, "0", "00110000")
TextBox2 = Replace(TextBox1.Text, "1", "00110001")
・・・
TextBox2 = Replace(TextBox1.Text, "ア", "10110001")
・・・


最初は上のように記述していこうと考えていたのですが、先が長そうなので途中で断念しました。
この書き方の代わりになる、関数・マクロ等はありますでしょうか?

どなたか知っていたら教えてください。

【17419】Re:文字列を8ビットコードに簡単に変換し...
回答  Hirofumi  - 04/8/29(日) 1:11 -

引用なし
パスワード
   「JIS8単位コード」が善く解らないのですが?
ASCIIコードと同じなら以下の様で善いのかな?
以下を標準モジュールに記述して下さい

Option Explicit

Public Function JIS8(ByVal strValue As String) As String

  Dim lngASCNo As Long
  
  lngASCNo = Asc(Left(strValue, 1))
  If Not ((&H20 < lngASCNo And lngASCNo < &H7F) _
      Or (&HA1 < lngASCNo And lngASCNo < &HE0)) Then
    Exit Function
  End If
  
  JIS8 = Right(String(8, "0") & ToSystem(lngASCNo, 2), 8)
  
End Function

Public Function ToSystem(ByVal lngDecimal As Long, _
            ByVal lngSystem As Long) As String

  Dim strResult As String
  Dim lngRemainder As Long
  Dim strRemainder As String
  
  If lngSystem < 2 Then
    Exit Function
  End If
  
  Do Until lngDecimal = 0
    lngRemainder = lngDecimal Mod lngSystem
    If lngRemainder > 9 Then
      strRemainder = Chr(65 + lngRemainder - 10)
    Else
      strRemainder = CStr(lngRemainder)
    End If
    strResult = strRemainder & strResult
    lngDecimal = lngDecimal \ lngSystem
  Loop
  
  ToSystem = strResult
  
End Function

TextBoxのイベントの方は、

TextBox2.Text = JIS8(TextBox1.Text)

として下さい

【17423】Re:文字列を8ビットコードに簡単に変換し...
質問  HyperVTEC  - 04/8/29(日) 9:25 -

引用なし
パスワード
   Hirofumiさん。
お返事ありがとうございます。

教わったとおりに記述してみました。
一応動いたのですが・・・

12という文字列を変換する場合、0011000100110010 と、このように変換したいのですが、この記述では
12という文字列を変換する場合、00110001 と、変換されてしまいます。
要はこの記述では頭の一文字(この例では1)しか変換されず、残りの文字(この例では2)は消える ということになるようです。

頭の一文字だけでなく、残りの文字も全て変換できるような記述の方法はありませんでしょうか?

お手数をおかけします、宜しくお願い致します。

【17425】Re:文字列を8ビットコードに簡単に変換し...
発言  ichinose  - 04/8/29(日) 10:58 -

引用なし
パスワード
   ▼HyperVTEC さん:
おはようございます。

>ExcelVBAで、textboxに入力した文字列をJIS8単位コードに変換するプログラムを作りたいのですが・・・
シフトJISではなく、JISコードでいいんですね?
(もっとも半角の場合は、どっちでも一緒でしたっけ?)

以下に示すコードは、Userform1にTextbox1とTextbox2及び、Commandbutoon1を
貼り付けたときの例題です。
Textbox1に入力された文字列をCommandbutoon1のクリックにより、
Textbox2にJISコードを2進数で表示します。

Userform1のモジュールに

'=============================================================
Private Sub CommandButton1_Click()
  Dim bitnum
  TextBox2.Text = ""
  With TextBox1
   i = 1
   Do While i <= Len(.Text)
    If LenB(StrConv(Mid(.Text, i, 1), vbFromUnicode)) = 1 Then
      bitnum = 8
    Else
      bitnum = 16
      End If
    'TextBox2.Text = TextBox2.Text & sp_dec2bin(Asc(Mid(.Text, i, 1)), bitnum)
'    ↑シフトJISの場合は、上のコード
    TextBox2.Text = TextBox2.Text & sp_dec2bin(Evaluate("code(""" & Mid(.Text, i, 1) & """)"), bitnum)
    i = i + 1
    Loop
   End With
End Sub
'===================================================================
Function sp_dec2bin(dnum, Optional scl = 8) As Variant
'機能  指定された数値を2進数文字列に変換する
'input dnum 変換する数値
'    scl 変換桁数
'output sp_dec2bin 2進数文字列
  Dim wk As Long
  wk = dnum
  sp_dec2bin = ""
  For idx = scl - 1 To 0 Step -1
   ans = wk And (2 ^ idx)
   sp_dec2bin = sp_dec2bin & IIf(ans > 0, 1, 0)
   Next idx
End Function

全角文字も2バイトで変換するようにしました。
確認してみて下さい。

【17426】Re:文字列を8ビットコードに簡単に変換し...
回答  Hirofumi  - 04/8/29(日) 11:38 -

引用なし
パスワード
   例えば、TextBox1のAfterUpdateイベントで行うとすれば以下の様に成ります

Private Sub TextBox1_AfterUpdate()

  Dim i As Long
  Dim strBuff As String
  Dim strData As String
  Dim strResult As String
  
  strData = TextBox1.Text
  If strData <> "" Then
    For i = 1 To Len(strData)
      strBuff = JIS8(Mid(strData, i, 1))
      If strBuff <> "" Then
        strResult = strResult & strBuff
      Else
        Beep
        MsgBox "変換できない文字が含まれています 「" _
                & Mid(strData, i, 1) & "」"
        Exit Sub
      End If
    Next i
    TextBox2.Text = strResult
  End If
  
End Sub

後、以下のコードを「Sub JIS8」に追加して下さい

Public Function JIS8(ByVal strValue As String) As String

  Dim lngASCNo As Long
  
  If strValue = "" Then '※追加
    Exit Function '※追加
  End If '※追加
  
  lngASCNo = Asc(Left(strValue, 1))

【17428】Re:文字列を8ビットコードに簡単に変換し...
質問  HyperVTEC  - 04/8/29(日) 11:56 -

引用なし
パスワード
   Hirofumiさん、ichinoseさん、たいへん丁寧なご返答どうも有難うございました。
今ほど、どちらの方法でも正常動作を確認しました。

最後にもう一つお伺いしたいことがあるのですが・・・
このプログラムで変換した文字列を、別のプログラムで元に戻したいのです。
(このプログラムで12という文字列を0011000100110010と変換したのち、別のプログラムで0011000100110010を12に変換したいのです)

出来ましたら、上記の処理を行うプログラムの記述内容を教えていただけませんでしょうか。

宜しくお願い致します。

【17431】Re:文字列を8ビットコードに簡単に変換し...
回答  Hirofumi  - 04/8/29(日) 12:46 -

引用なし
パスワード
   善くTest指定無いので上手く動くのか?

以下を標準モジュールに記述して下さい

Option Explicit

Public Function Decode(ByVal strValue As String) As String

  Dim i As Long
  Dim strBuff As String
  Dim strResult As String
  
  If strValue = "" Then
    Exit Function
  End If
  
  For i = 1 To Len(strValue) Step 8
    strBuff = Mid(strValue, i, 8)
    strResult = strResult & Chr(ToDecimal(strBuff, 2))
  Next i
  
  Decode = strResult

End Function

Public Function ToDecimal(ByVal strValue As String, _
            ByVal lngSystem As Long) As Long

  Dim i As Long
  Dim lngWeight As Long
  Dim lngLeng As Long
  Dim lngResult As Long
  Dim lngBase As Long
  Dim strBase As String
  
  If strValue = "" Then
    Exit Function
  End If
  
  strValue = StrConv(strValue, vbNarrow + vbUpperCase)
  lngLeng = Len(strValue)
  lngWeight = lngSystem ^ (lngLeng - 1)
  For i = 1 To lngLeng
    strBase = Mid(strValue, i, 1)
    Select Case Asc(strBase)
      Case 48 To 57
        lngBase = CLng(strBase)
      Case 65 To 90
        lngBase = 10 + Asc(strBase) - 65
      Case Else
        Exit Function
    End Select
    lngResult = lngResult + lngBase * lngWeight
    lngWeight = lngWeight \ lngSystem
  Next i
  
  ToDecimal = lngResult
  
End Function

UserFormのTextBox2に有る値をCommandButton1を押すと
TextBox3に結果を表示します

Private Sub CommandButton1_Click()

  TextBox3.Text = Decode(TextBox2.Text)
  
End Sub

【17433】Re:文字列を8ビットコードに簡単に変換し...
お礼  HyperVTEC  - 04/8/29(日) 13:50 -

引用なし
パスワード
   Hirofumiさん

お返事ありがとうございます。
早速試してみましたところ、何の問題もなく正常動作しました!

どうも有難うございました。


ichinoseさん

ichinoseさんの方法でJISコードに変換したものを、もう一度もとの形に戻す記述方法にも興味があります。
宜しければその内容を教えていただけませんでしょうか?

【17434】Re:文字列を8ビットコードに簡単に変換し...
発言  ichinose  - 04/8/29(日) 14:34 -

引用なし
パスワード
   ▼HyperVTEC さん:
こんにちは。

>
>ichinoseさんの方法でJISコードに変換したものを、もう一度もとの形に戻す記述方法にも興味があります。
>宜しければその内容を教えていただけませんでしょうか?
戻すとは思っていませんでした・・・。

そうなると、全角文字を戻すのは厄介というより、私にはわかりません。
例えば、前回のコードで全角の5を2進数にすると
「0010001100110101」となりますよね?
ところが前1バイトの「00100011」って、半角の「#」ですよね?
つまり、2進数だけでは1バイトコードか2バイトコードなのかということが
判断できません(シフトJISなら何とかできそうですけど)。
JISコードの場合、実際には「全角文字ですよ」っていう制御コードがあるんですよね?

半角だけと言う仕様なら可能ですし、又は、2進数に区切り文字でもあれば
可能ですけどね!
例えば全角の「123」の場合、

「0010001100110001 0010001100110010 0010001100110011」

というように空白でも入っていれば可能ですが・・・。
このばあいは、2進数文字列を数値に変換した後、ワークシート関数のChar()関数で
戻す方法で可能だと思いますが・・・。

ということでごめんなさい・・・。

【17435】Re:文字列を8ビットコードに簡単に変換し...
お礼  HyperVTEC  - 04/8/29(日) 16:56 -

引用なし
パスワード
   ichinoseさん

了解しました。
どうも有難うございました!

【17436】Re:文字列を8ビットコードに簡単に変換し...
発言  ichinose  - 04/8/29(日) 17:47 -

引用なし
パスワード
   ▼HyperVTEC さん:
>了解しました。
>どうも有難うございました!
ちょっと遅かったみたいですねえ・・・。

一応考えてみました。但し、この場合、最初の文字列をJISコード変換するコードから
変更しなければなりません。つまり、制御コードも入れるということです。
JISコード自体もう何年も扱っていないので忘れてしまっているところもありますが。
以下のコードは、
Userform1にTextbox1、Textbox2、Textbox3と
Commandbutton1とCommandbutton2を貼り付けてください。

仕様は、Commandbutton1クリックでTextbox1の文字列をJISコード変換してTextbox2
に表示、Commandbutton2クリックでTextbox2を入力データとして文字列変換したものを
Textbox3に表示します。

userform1のモジュールに

'============================================
Const ki As String = "000110110010010001000010"
Const ko As String = "000110110010100001001010"
'================================================
Private Sub CommandButton1_Click()
  Dim kj As Boolean
  Dim bitnum
  Dim wk As Long
  TextBox2.Text = ""
  kj = False
  With TextBox1
   i = 1
   Do While i <= Len(.Text)
    If LenB(StrConv(Mid(.Text, i, 1), vbFromUnicode)) = 1 Then
      If kj = True Then
       TextBox2.Text = TextBox2.Text & ko
       kj = False
       End If
      bitnum = 8
    Else
      If kj = False Then
       TextBox2.Text = TextBox2.Text & ki
       kj = True
       End If
      bitnum = 16
      End If
    If Mid$(.Text, i, 1) = Chr(-32408) Then
     wk = 8521
    Else
     wk = Evaluate("code(""" & Mid$(.Text, i, 1) & """)")
     End If
    TextBox2.Text = TextBox2.Text & sp_dec2bin(wk, bitnum)
    i = i + 1
    Loop
   If kj = True Then TextBox2.Text = TextBox2.Text & ko
   End With
End Sub
'==============================================================
Function sp_dec2bin(dnum, Optional scl = 8) As Variant
'機能  数値を2進数文字列に変換する
'input dnum 変換する数値
'    scl 2進数の桁数
'output sp_dec2bin 2進数文字列
  Dim wk As Long
  wk = dnum
  sp_dec2bin = ""
  For idx = scl - 1 To 0 Step -1
   ans = wk And (2 ^ idx)
   sp_dec2bin = sp_dec2bin & IIf(ans > 0, 1, 0)
   Next idx
End Function
'========================================================
Function sp_bin2dec(binstr) As Long
'機能  指定された2進数文字列を数値に変換する
'input binstr 2進数文字列
'output sp_bin2dec 変換数値
  Dim l_str As Long
  l_str = Len(binstr)
  sp_bin2dec = 0
  For idx = 1 To l_str
   sp_bin2dec = sp_bin2dec + Mid(binstr, idx, 1) * (2 ^ (l_str - idx))
   Next idx
End Function
'====================================================
Private Sub CommandButton2_Click()
  Dim kj As Boolean
  Dim bitnum
  Dim wk As String
  kj = False
  With TextBox3
   .Text = ""
   wk = get_byte(TextBox2.Text)
   Do While wk <> ""
    If sp_bin2dec(wk) = 27 Then
      wk = wk & get_byte() & get_byte()
      If wk = ki Then
       kj = True
      ElseIf wk = ko Then
       kj = False
       End If
    Else
      If kj = True Then
       wk = wk & get_byte()
       End If
      .Text = .Text & Evaluate("char(" & sp_bin2dec(wk) & ")")
      End If
    wk = get_byte()
    Loop
   End With
End Sub
'===========================================================
Function get_byte(Optional b_str = "") As Variant
'機能  指定された2進数文字列を1バイトづつ取り出す
'input b_str(2回目以降の呼び出しでは指定しない)
'output get_byte 1バイト分の2進数文字列 ""の場合、データの終わり
  Static sv_str
  Static c_idx As Long
  If b_str <> "" Then
   sv_str = b_str
   c_idx = 1
   End If
  If Len(Mid(sv_str, c_idx)) < 8 Then
   get_byte = ""
  Else
   get_byte = Mid(sv_str, c_idx, 8)
   c_idx = c_idx + 8
   End If
End Function


但し、Commandbutton1をクリックしたことにより、変換された2進数文字列以外は
逆変換はできませんので、ご了承ください。

【17437】Re:文字列を8ビットコードに簡単に変換し...
質問  HyperVTEC  - 04/8/29(日) 18:28 -

引用なし
パスワード
    何度もすみません...

教えて頂いたように記述してみました。
ですが、全角文字を入力した際、JISコードへの変換は問題ないようですが、JISコードからの変換(元に戻す作業)がうまくいっていないようです。
textbox3に文字化けして出てきます。


教えて頂いた文は全てUserform1のコードに記述すればよいのでしょうか?

お手数をおかけし申し訳ありません。

宜しくお願い致します。

【17438】Re:文字列を8ビットコードに簡単に変換し...
発言  ichinose  - 04/8/29(日) 18:39 -

引用なし
パスワード
   ▼HyperVTEC さん:
こんばんは。

>
>教えて頂いたように記述してみました。
>ですが、全角文字を入力した際、JISコードへの変換は問題ないようですが、JISコードからの変換(元に戻す作業)がうまくいっていないようです。
>textbox3に文字化けして出てきます。
どんな文字列を入力したときですか?不具合時の全角文字列が何なのか
教えて下さい。こちらでも何回かTestしましたが、うまく表示されているんですが。


>
>教えて頂いた文は全てUserform1のコードに記述すればよいのでしょうか?
はい、全てUserform1のモジュールです。

【17439】Re:文字列を8ビットコードに簡単に変換し...
お礼  HyperVTEC  - 04/8/29(日) 19:00 -

引用なし
パスワード
   ichinoseさん

どうもです。

'============================================
Const ki As String = "000110110010010001000010"
Const ko As String = "000110110010100001001010"
'============================================
を入力する位置をちょっと変えてみたら、正常動作するようになりました!

いろいろとどうも有難うございました。感謝します。

11209 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free