Excel VBA質問箱 IV

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

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


56156 / 76732 ←次へ | 前へ→

【25336】Re:文字の置き換え
発言  ichinose  - 05/5/28(土) 21:33 -

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

>はじめまして。ExcelVBAの質問させてください。
>質問1
>ASC関数を使い全角2バイトを半角1バイトに変換したあと半角変換できない文字は「-」に置き換える。
>11大阪府11→11-11
>質問2
>半角変換できない文字の後に文字が続かない場合は省略する。
>11大阪府→11
>質問3
>「-」に置き換えた結果「-」が連続する場合は「-」をひとつ省略する。
>11大阪府-11→11-11
>
>実際には何万というレコードが有り一番上から順番に処理していくような方法にしたいと思っています。
>よろしくお願い致します。

非常にわかりやすいご質問の記述ですね!!

'============================================================
Dim regEx As Object
Sub test()
  Set regEx = CreateObject("VBScript.RegExp")
  変換文字列 = "11大阪府-11"
  MsgBox get_replace(StrConv(変換文字列, vbNarrow), "-")
  変換文字列 = "123---大阪府-11-123---"
  MsgBox get_replace(StrConv(変換文字列, vbNarrow), "-")
  Set regEx = Nothing
End Sub
'=====================================================================
Function get_replace(mystr, cnvstr, Optional ByVal short As Boolean = True) As String
'全角文字を指定文字に変換する
'input mystr----変換対象文字列
'    cnvstr---検索文字
'    short----省略可---True---短縮処理と末尾処理を行う
'output get_replace---変換された文字列
  Dim chkidx As Long
  Dim get_replacewk As String
  chkidx = 1
  get_replacewk = ""
  Do While chkidx <= Len(mystr)
   If LenB(StrConv(Mid(mystr, chkidx, 1), vbFromUnicode)) = 2 Then
    get_replacewk = get_replacewk & cnvstr
   Else
    get_replacewk = get_replacewk & Mid(mystr, chkidx, 1)
    End If
   chkidx = chkidx + 1
   Loop
  If short = True Then
   Set regEx = CreateObject("VBScript.RegExp")
   regEx.Pattern = "\" & cnvstr & "{2,}"
   regEx.IgnoreCase = True
   Do
    get_replacewk = regEx.Replace(get_replacewk, cnvstr)
    Loop While regEx.test(get_replacewk)
   regEx.Pattern = "\" & cnvstr & "{1,}$"
   Do
    get_replacewk = regEx.Replace(get_replacewk, "")
    Loop While regEx.test(get_replacewk)
   get_replace = get_replacewk
  Else
   get_replace = get_replacewk
   End If
End Function

プロシジャーtestは一例ですから、このプロシジャーに一万行の
ループ処理と言う事になりますが・・・。

確認してみて下さい。
0 hits

【25322】文字の置き換え hiroshi 05/5/28(土) 15:01 質問
【25336】Re:文字の置き換え ichinose 05/5/28(土) 21:33 発言
【25345】Re:文字の置き換え 一箇所訂正 ichinose 05/5/29(日) 9:28 発言
【25359】Re:文字の置き換え 一箇所訂正 hiroshi 05/5/29(日) 15:49 お礼
【25340】Re:文字の置き換え Hirofumi 05/5/29(日) 1:18 回答
【25342】Re:文字の置き換え Hirofumi 05/5/29(日) 8:19 回答
【25349】Re:文字の置き換え Hirofumi 05/5/29(日) 10:35 回答
【25360】Re:文字の置き換え hiroshi 05/5/29(日) 15:50 お礼

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