エクセルで数字の変換

質問

エクセル2000です。
ひとつのセルの中に、たとえば「2009年は第1、第5営業部の24名」という文字列があったとします。これを半角一桁の数字のみに限定して全角の数字に変換する方法はないでしょうか？
JIS関数だとすべてが全角になってしまいます。
関数でもVBAでもかまいません。
「2009年は第１、第５営業部の24名」と変換したいのです。

対象が何百もあるので困っています。
よろしくお願いします。

回答No.4

end-u · ベストアンサー

スマートかどうかは別として、考え方の一例ですが

Sub test()
　　Dim rng As Range
　　Dim r　 As Range
　　Dim chk As String
　　Dim s　 As String
　　Dim ss　As String
　　Dim i　 As Long
　　Dim p　 As Long

　　On Error Resume Next
　　Set rng = ActiveSheet.UsedRange _
　　　　　　　.SpecialCells(xlCellTypeConstants, xlTextValues)
　　On Error GoTo 0
　　If rng Is Nothing Then Exit Sub

　　For Each r In rng
　　　　chk = r.Value
　　　　p = 0
　　　　For i = 1 To Len(chk) + 1
　　　　　　s = Mid$(chk, i, 1)
　　　　　　If IsNumeric(s) Then
　　　　　　　　p = p + 1
　　　　　　　　ss = ss & s
　　　　　　Else
　　　　　　　　If p > 0 Then
　　　　　　　　　　If p = 1 Then
　　　　　　　　　　　　Mid$(chk, i - 1, 1) = StrConv(ss, vbWide)
　　　　　　　　　　Else
　　　　　　　　　　　　Mid$(chk, i - p, p) = StrConv(ss, vbNarrow)
　　　　　　　　　　End If
　　　　　　　　　　p = 0
　　　　　　　　　　ss = Empty
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　r.Value = chk
　　Next

　　Set rng = Nothing
End Sub

処理範囲を文字列のセル範囲に限定してLoopする。
数値の連続数を記憶することでIsNumeric判定を１回で済ます。
とともに、連続数を使って非数値の時に条件分岐してまとめて処理する。
『Len(chk) + 1』で１回多くLoopし、最後が数値の時も処理が行われるようにする。

...といったような感じのコードもあるかと。

お礼

end-uさま、いつもお世話になります。

>『Len(chk) + 1』で１回多くLoopし、最後が数値の時も処理が行われるようにする。

「目からうろこ」です。
MIDで文字数を超える指定ができるとは思いもよりませんでした。
ありがとうございます。
(o。_。)oペコッ

> Mid$(chk, i - 1, 1)
この＄マークはMIDで取り出した文字を「文字列」として返すための指定でしたっけ？
Dim chk As Stringで文字列と宣言しても＄を入れたほうがよいのでしょうか？
(￣～￣;)う～ん　
不勉強ですみませんがご教示いただけると幸いです。

回答No.10

cj_mover

またまた登場、cjです。（パクリ(^^;）

余計なことかも知れませんが、、、
もしや、回答No.8、見逃してませんかね？
それで、、、混乱しないように補足しようと思ったのですが、
Mid$()関数や、Mid$ ステートメントなどに付いている「＄」は
関数名の一部ですので、型宣言文字とは違います。
＃８でも十分説明されていますけれど、
＃９が並んでいると誤解され易いと思いましたので、念の為です。

余計なことついでですが
Googleの検索においても次のようなキーワードで試した処、
「&」記号は認識されるようですよ。
【"Dim i&"】
【"Dim i&" "変数"】
【"Dim i&" "変数" "VBA"】
（DQで括ってあげないと面倒臭いですが）
っつか、「$」と「&」って役物記号でしたっけ？
「<」「>」の検索がうまくいかないのとは違うと思うのですけれど。
（この辺りの話は私も詳しくはないですが）

＞越後の季節限定の冷酒
＃いいっすねー。私も年始は酒三昧っした。

お礼

> Mid$()関数や、Mid$ ステートメントなどに付いている「＄」は
> 関数名の一部ですので、型宣言文字とは違います。

はい、＄付き関数のメリットを勉強させていただきました。
ありがとうございました。

回答No.9

cj_mover

こんにちわ＾＾

＞Dim i&, sLN$　ってどういう意味でしょうか？
「＆」は長整数(Long)型、「＄」は文字列(String)型、
を宣言する「型宣言文字(列)」といいます。
ぜひ、ローカルウィンドウで変数の型を確認してみてください。
詳しくは（私が解説するよりも）
【"Excel" "VBA" "型宣言文字"】などのキーワードで検索してみてください。
（可能ならこの辺のことは整理された書籍が一冊手元にあると安心です）
昨日は携帯電話からの投稿で、文字数制限がキツかったもので、
（コメントがぎこちないのも、そのせいです）
省略した表記にしただけなので、
こうした表記を奨めている訳ではありません。
標準表記
Dim i As Long
Dim sLN As String
と同じ意味ですので、直して読んで頂けると幸いです。

デバッグ、というと、ステップモード実行でいちいち面倒臭い、
という印象でしょうか？
「ブレークポイントを設定して実行し、ローカルウィンドウで
変数の内容を確認する」だけでも、
ソースを読む時、書く時、大きな力になると思います。
「処理の流れ」を（視覚的に）把握するのは重要なことで、また、
「処理の流れさえ掴んでしまえば」随分と易しく、
読めて、書けるようになるんだと思います。
（伝わり難いでしょうが）私としては期待を込めてレスしたつもりです。

＃今からまた、芋焼酎です(^^;

それでは、また＾＾

お礼

"型宣言文字"　という言葉を存じていなかったため調べられませんでしたが、おかげさまで検索が出来ました。
ありがとうございます。
これからもよろしくご指導のほどお願い申し上げます。

わたしは昨夜は越後の季節限定の冷酒でした・・・
(〃^o^)ノロ*ロヾ(´∇｀=) Cheers!!

回答No.8

end-u

>s = Mid$(chk, i, 1)
こちらがMid関数です。文字列の任意の部分を取り出す時に使います。
>Mid$(chk, i - 1, 1) = StrConv(ss, vbWide)
こちらはMidステートメント。文字列の任意の場所に書き込む時に使います。

http://www.excellenceweb.net/vba/programing/mid.html

そう言えばMidステートメントで
>Mid$(chk, i - 1, 1) =...
という書き方ってあまり見かけませんね。（というか普通書かないのかな？）
Mid(chk, i - 1, 1) =...
で構いません。
速度的なものを簡単にチェックしてみましたけど、Mid関数と違って$の有無で大差ないようですし。
Midステートメントの機能からして、$をつけないほうがしっくりくるかもしれませんね。
（内部的にどういった処理がされているのかまでは、解りませんが）

Mid関数の場合は文字列型変数に受ける時も$つき関数のほうが良いようです。
http://www.tsware.jp/labo/labo_32.htm

お礼

Mid関数とMidステートメント の違い、そして参考URLの

「Mid$関数とMid関数、Left$関数とLeft関数など、文字列処理を行う関数に多く存在しています。
基本的な違いとして、＄が付いた関数は文字列型の値を返します。
一方付いていないものはバリアント型の値を返します。」

とても勉強になりました。

ありがとうございます。
今後ともご指導のほど、お願い申し上げます。

回答No.7

cj_mover

あ、全角→半角もあるんだ！
＃５です。読み落としにつきやり直し。
失礼しました。

Function MyFn_C(ByVal SM As String)
Const SP = " ", MK = "1", MP = SP & MK & SP
Dim i&, sLN$
　sLN = Space$(Len(SM) + 2&)
　For i = 1 To Len(SM)
　　If IsNumeric(Mid$(SM, i, 1)) Then Mid$(sLN, i + 1&) = MK
　Next i
　i = 0
　Do
　　i = InStr(i + 1&, sLN, MP)
　　If i Then
　　　Mid$(SM, i) = StrConv(Mid$(SM, i, 1), vbWide)
　　　Mid$(sLN, i + 1&) = SP
　　Else
　　　Exit Do
　　End If
　Loop
　Do
　　i = InStr(i + 1&, sLN, MK)
　　If i Then
　　　Mid$(SM, i - 1&) = StrConv(Mid$(SM, i - 1&, 1), vbNarrow)
　　Else
　　　Exit Do
　　End If
　Loop
　MyFn_C = SM
End Function

Function MyFn_J(ByVal SM As String)
Dim lLN&, i&
　lLN = Len(SM)
ReDim flgA(0 To lLN + 1&) As Boolean ' flgA(lLN) じゃないよ！
　For i = 1 To lLN
　　If IsNumeric(Mid$(SM, i, 1)) Then flgA(i) = True
　Next i
　For i = 1 To lLN
　　If flgA(i) Then
　　　If flgA(i - 1&) Or flgA(i + 1&) Then
　　　　Mid$(SM, i) = StrConv(Mid$(SM, i, 1), vbNarrow)
　　　Else
　　　　Mid$(SM, i) = StrConv(Mid$(SM, i, 1), vbWide)
　　　End If
　　End If
　Next i
　MyFn_J = SM
End Function

お礼

cj_moverさま、いつもありがとうございます。
ご教示のユーザー定義関数でワークシートでも出来ました。
すごいですね。
まだ呪文の中身を理解できていませんので勉強させていただきたいと思いますが変数宣言で
Dim i&, sLN$　ってどういう意味でしょうか？
"$"は文字列、"%"は数値であろうと想像しますが、"&"はなんなのでしょうか？
記号はGogleで検索できないので困ってます。

回答No.6

cj_mover

＃５の訂正です。
久々に書いたせいか雑でした。

誤
＞　　If flgA(i) And Not flgA(i + 1&) Then
＞　　　If flgA(i - 1&) Xor flgA(i) Then _
修正
　　If flgA(i) Then
　　　If Not (flgA(i - 1&) Or flgA(i + 1&)) Then _

以上勘違いでした（汗。
どっちにしろスマートじゃなかったかも、ですね。

では、またー^^

回答No.5

cj_mover

こんにちわ^^
参考程度ですが、ワークシート用も兼ねた関数の簡易版２種。
質はともかく、デバッグの練習用には面白いかも？
フラグを採って改めてループした方が楽だったり。
（大筋で）私は好きな書き方なんですけどね。

Function MyFunc_C(ByVal SM As String)
Const MK As String = "1", MP As String = " " & MK & " "
Dim i&, sLN$
　sLN = Space$(Len(SM) + 2&)
　For i = 1 To Len(SM)
　　If IsNumeric(Mid$(SM, i, 1)) Then Mid$(sLN, i + 1&) = MK
　Next i
　i = 0
　Do
　　i = InStr(i + 1&, sLN, MP)
　　If i Then ' If i > 0 Then
　　　Mid$(SM, i) = StrConv(Mid$(SM, i, 1), vbWide)
　　Else
　　　Exit Do
　　End If
　Loop
　MyFunc_C = SM
End Function

Function MyFunc_J(ByVal SM As String)
Dim lLN&, i&, lBf&
　lLN = Len(SM)
ReDim flgA(0 To lLN + 1&) As Boolean ' flgA(lLN) じゃないよ！
　For i = 1 To lLN
　　lBf = Asc(Mid$(SM, i))
　　If lBf > 47& And lBf < 58& Then flgA(i) = True ' 正しく全角ならスルー
　Next i
　For i = 1 To lLN
　　If flgA(i) And Not flgA(i + 1&) Then
　　　If flgA(i - 1&) Xor flgA(i) Then _
　　　　Mid$(SM, i) = StrConv(Mid$(SM, i, 1), vbWide)
　　End If
　Next i
　MyFunc_J = SM
End Function

唐突ですが(^^;)
merlionXXさん
と、
end-uさん
の、
ご回答はいつも必ず拝見して勉強させて頂いてます。
（応援メッセージのつもり^^）

回答No.3

ka_na_de

＃１です。
こんばんは。

お役に立てたようで幸いです。

こちらは、ど素人ですので、
もしよろしければ、もうしばらく締め切らずに
他の回答を待っていただけないでしょうか？

もっとスマートなコードの提示があれば、
拝見して勉強させて頂きたいと思います。

お礼

ka_na_deさま、ほんとに助かりました。
LOOPしながら、どうやって１桁であるという判定をする方法が思い浮かばなかったので、ダミーを持ってくる方法はとても勉強になりました。

回答No.2

ka_na_de

＃１です。

間違いがありました。
修正します。

Sub test2()
　　Dim myRange As Range, c As Range
　　Dim i As Integer
　　Dim myTgt As String, nextTgt As String
　　Dim oldTgt As String, myStr As String

　　Set myRange = Range("A1:A2")　　'対象範囲

　　For Each c In myRange
　　　　myStr = ""
　　　　oldTgt = "dummy"
　　　　For i = 1 To Len(c.Value)
　　　　　　myTgt = Mid(c.Value, i, 1)
　　　　　　If i < Len(c.Value) Then
　　　　　　　　nextTgt = Mid(c.Value, i + 1, 1)
　　　　　　Else
　　　　　　　　nextTgt = "dummy"
　　　　　　End If
　　　　　　If IsNumeric(myTgt) And Not IsNumeric(nextTgt) And Not IsNumeric(oldTgt) Then
　　　　　　　　myTgt = StrConv(myTgt, vbWide)
　　　　　　End If
　　　　　　oldTgt = myTgt
　　　　　　myStr = myStr & myTgt
　　　　Next i
　　　　c.Value = myStr
　　Next c

　　Set myRange = Nothing
End Sub

お礼

ka_na_deさま、ありがとうございます！
質問では洩れていましたが、数字が全半角混在していまして、半角一桁の数字のみ限定して全角の数字とし、それ以外の数字は半角としなければなりませんでした。
ご教示のコードを以下のとおり、ほんの少しだけ変えることで無事対応できました。
助かりました。

Sub test2()
　　Dim myRange As Range, c As Range
　　Dim i As Integer
　　Dim myTgt As String, nextTgt As String
　　Dim oldTgt As String, myStr As String
　　Set myRange = ActiveSheet.UsedRange
　　For Each c In myRange
　　　　myStr = ""
　　　　oldTgt = "dummy"
　　　　For i = 1 To Len(c.Value)
　　　　　　myTgt = Mid(c.Value, i, 1)
　　　　　　If IsNumeric(myTgt) Then
　　　　　　　　myTgt = StrConv(myTgt, vbNarrow)
　　　　　　End If
　　　　　　If i < Len(c.Value) Then
　　　　　　　　nextTgt = Mid(c.Value, i + 1, 1)
　　　　　　Else
　　　　　　　　nextTgt = "dummy"
　　　　　　End If
　　　　　　If IsNumeric(myTgt) And Not IsNumeric(nextTgt) And Not IsNumeric(oldTgt) Then
　　　　　　　　myTgt = StrConv(myTgt, vbWide)
　　　　　　End If
　　　　　　oldTgt = myTgt
　　　　　　myStr = myStr & myTgt
　　　　Next i
　　　　c.Value = myStr
　　Next c
　　Set myRange = Nothing
End Sub

回答No.1

ka_na_de

こんばんは。

一例です。

Sub test()
　　Dim myRange As Range, c As Range
　　Dim i As Integer
　　Dim myTgt As String, nextTgt As String
　　Dim oldTgt As String, myStr As String

　　Set myRange = Range("A1:A2")　　'対象範囲

　　For Each c In myRange
　　　　myStr = ""
　　　　oldTgt = "dummy"
　　　　nextTgt = "dummy"
　　　　For i = 1 To Len(c.Value)
　　　　　　myTgt = Mid(c.Value, i, 1)
　　　　　　If i < Len(c.Value) Then nextTgt = Mid(c.Value, i + 1, 1)
　　　　　　If IsNumeric(myTgt) And Not IsNumeric(nextTgt) And Not IsNumeric(oldTgt) Then
　　　　　　　　myTgt = StrConv(myTgt, vbWide)
　　　　　　End If
　　　　　　oldTgt = myTgt
　　　　　　myStr = myStr & myTgt
　　　　Next i
　　　　c.Value = myStr
　　Next c

　　Set myRange = Nothing
End Sub

お礼

ありがとうございました。