Excel VBA質問箱 IV

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

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


12916 / 13646 ツリー ←次へ | 前へ→

【7979】全角→半角変換について TANK 03/9/25(木) 18:04 質問
【7981】アルファベットのみじゃないけど ぴかる 03/9/25(木) 18:27 発言
【7983】Re:アルファベットのみじゃないけど bykin 03/9/25(木) 19:28 回答
【7994】ありがとうございます! TANK 03/9/26(金) 1:27 お礼
【7995】Re:アルファベットのみじゃないけど ichinose 03/9/26(金) 1:38 回答

【7979】全角→半角変換について
質問  TANK  - 03/9/25(木) 18:04 -

引用なし
パスワード
   はじめてのカキコです。よろしくお願いします。

エクセルのファイルの中身のデータ(アルファベットのみ)を
全角から半角に変換したいのですが、どのようなコードを使えばできるのでしょうか。
どなたかお教え願います。

【7981】アルファベットのみじゃないけど
発言  ぴかる  - 03/9/25(木) 18:27 -

引用なし
パスワード
   TANKさん、こんにちは。

>エクセルのファイルの中身のデータ(アルファベットのみ)を
>全角から半角に変換したいのですが、どのようなコードを使えばできるのでしょうか。
↓ソフトの文字変換機能にて、半角変換が可能です。でも全部変換しちゃうんでNGですけど・・・。
よかったらダウンロード後、おためしコーナーにて体験してみて下さい。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=36;id=FAQ

このページのトップに行けば、ダウンロードコーナーがあります。そこにここの管理人さん(谷さん)作の楽々マクロ(だったと思う)というのがあります。そのソフトの機能にご希望のものがあったのではと思います。紹介文のみを以前に見ただけなので、違ってたら、ゴメンナサイ。

【7983】Re:アルファベットのみじゃないけど
回答  bykin  - 03/9/25(木) 19:28 -

引用なし
パスワード
   こんばんわ。

こんなんかな?

Sub test()
  Dim i As Long
  Application.ScreenUpdating = False
  For i = 65 To 90
    Cells.Replace What:=Chr(i), Replacement:=Chr(i), LookAt:=xlPart, MatchCase:=True, MatchByte:=False
    Cells.Replace What:=Chr(i + 32), Replacement:=Chr(i + 32), LookAt:=xlPart, MatchCase:=True, MatchByte:=False
  Next
  Application.ScreenUpdating = True
End Sub

試してみてな。
ほな。

【7994】ありがとうございます!
お礼  TANK  - 03/9/26(金) 1:27 -

引用なし
パスワード
   こんばんは。

お二方ともありがとうございます。

>ぴかるさん
早速ダウンロードしてためしました。
ただ残念ながらすべて半角になってしまったので・・・
ありがとうございました。

>bykinさん
なるほど。このコーディングだとなんとかなりそうです。
今、VBAをいじれる環境にいないので、明日ためしてみます!
ありがとうございました。

【7995】Re:アルファベットのみじゃないけど
回答  ichinose  - 03/9/26(金) 1:38 -

引用なし
パスワード
   こんばんは。

正規表現を使用した別解です。

但し、例は、アクティブシートに対しての全角--半角変換です。

標準モジュールに、
'==================================================
Dim regEx, Match, Matches
'==================================================
Sub main()
  Dim rng As Range
  Application.ScreenUpdating = False
  Set regEx = CreateObject("VBScript.RegExp")
  For Each rng In ActiveSheet.UsedRange
    With rng
     .Value = alph_cnv_narrow(.Value)
     End With
    Next
  Set regEx = Nothing
  Application.ScreenUpdating = True
End Sub
'=========================================================
Function alph_cnv_narrow(strng)
  regEx.Pattern = "([A-Z])+"
  regEx.IgnoreCase = True
  regEx.Global = True
  Set Matches = regEx.Execute(strng)
  alph_cnv_narrow = strng
  If Matches.Count > 0 Then
   For Each Match In Matches
     regEx.Pattern = Match.Value
     regEx.IgnoreCase = False
     alph_cnv_narrow = regEx.Replace(alph_cnv_narrow, StrConv(Match.Value, vbNarrow))
     Next
   End If
End Function

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