エクセルで数字の変換

Question

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

end-u · Accepted Answer

スマートかどうかは別として、考え方の一例ですが

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し、最後が数値の時も処理が行われるようにする。

...といったような感じのコードもあるかと。

cj_mover · Answer

またまた登場、cjです。（パクリ(^^;）

余計なことかも知れませんが、、、
もしや、回答No.8、見逃してませんかね？
それで、、、混乱しないように補足しようと思ったのですが、
Mid$()関数や、Mid$ ステートメントなどに付いている「＄」は
関数名の一部ですので、型宣言文字とは違います。
＃８でも十分説明されていますけれど、
＃９が並んでいると誤解され易いと思いましたので、念の為です。

余計なことついでですが
Googleの検索においても次のようなキーワードで試した処、
「&」記号は認識されるようですよ。
【"Dim i&"】
【"Dim i&" "変数"】
【"Dim i&" "変数" "VBA"】
（DQで括ってあげないと面倒臭いですが）
っつか、「$」と「&」って役物記号でしたっけ？
「<」「>」の検索がうまくいかないのとは違うと思うのですけれど。
（この辺りの話は私も詳しくはないですが）

＞越後の季節限定の冷酒
＃いいっすねー。私も年始は酒三昧っした。

cj_mover · Answer

こんにちわ＾＾

＞Dim i&, sLN$　ってどういう意味でしょうか？
「＆」は長整数(Long)型、「＄」は文字列(String)型、
を宣言する「型宣言文字(列)」といいます。
ぜひ、ローカルウィンドウで変数の型を確認してみてください。
詳しくは（私が解説するよりも）
【"Excel" "VBA" "型宣言文字"】などのキーワードで検索してみてください。
（可能ならこの辺のことは整理された書籍が一冊手元にあると安心です）
昨日は携帯電話からの投稿で、文字数制限がキツかったもので、
（コメントがぎこちないのも、そのせいです）
省略した表記にしただけなので、
こうした表記を奨めている訳ではありません。
標準表記
Dim i As Long
Dim sLN As String
と同じ意味ですので、直して読んで頂けると幸いです。

デバッグ、というと、ステップモード実行でいちいち面倒臭い、
という印象でしょうか？
「ブレークポイントを設定して実行し、ローカルウィンドウで
変数の内容を確認する」だけでも、
ソースを読む時、書く時、大きな力になると思います。
「処理の流れ」を（視覚的に）把握するのは重要なことで、また、
「処理の流れさえ掴んでしまえば」随分と易しく、
読めて、書けるようになるんだと思います。
（伝わり難いでしょうが）私としては期待を込めてレスしたつもりです。

＃今からまた、芋焼酎です(^^;

それでは、また＾＾

end-u · Answer

>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

cj_mover · Answer

あ、全角→半角もあるんだ！
＃５です。読み落としにつきやり直し。
失礼しました。

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 · Answer

＃５の訂正です。
久々に書いたせいか雑でした。

誤
＞　　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 _

以上勘違いでした（汗。
どっちにしろスマートじゃなかったかも、ですね。

では、またー^^

cj_mover · Answer

こんにちわ^^
参考程度ですが、ワークシート用も兼ねた関数の簡易版２種。
質はともかく、デバッグの練習用には面白いかも？
フラグを採って改めてループした方が楽だったり。
（大筋で）私は好きな書き方なんですけどね。

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さん
の、
ご回答はいつも必ず拝見して勉強させて頂いてます。
（応援メッセージのつもり^^）

ka_na_de · Answer

＃１です。
こんばんは。

お役に立てたようで幸いです。

こちらは、ど素人ですので、
もしよろしければ、もうしばらく締め切らずに
他の回答を待っていただけないでしょうか？

もっとスマートなコードの提示があれば、
拝見して勉強させて頂きたいと思います。

ka_na_de · Answer

＃１です。

間違いがありました。
修正します。

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 · Answer

こんばんは。

一例です。

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

エクセルで数字の変換

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

またまた登場、cjです。

こんにちわ＾＾

>s = Mid$(chk, i, 1)

あ、全角→半角もあるんだ！

＃５の訂正です。

こんにちわ^^

＃１です。

＃１です。

こんばんは。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング