|
こんばんは
皆さんの簡潔なコードは大変参考になります。
スマートでないですが私も作ってみました
SUBSTITUTE関数ならエラー対策が要らないと聞いていましたので。
セルが空白でも出来そうです。
接頭辞の付け方は皆さんのをまねました。
Sub 数字抽出()
Dim Data As Range
Dim 文字列 As String, moji As String,suuji As String
Set Data = Range(Cells(1, 1), Range("A65536").End(xlUp))
For Each myRng In Data
文字列 = StrConv(myRng, 8) '半角文字にしておく
'文字列から数字だけを消す
moji = 文字列
For i = 0 To 9
moji = Application.WorksheetFunction.Substitute(moji, i, "")
Next
R = Len(moji) '数字を除いた記号や文字の数
suuji = 文字列
'元の文字列から文字を消す
For i = 1 To R
suuji = Application.WorksheetFunction.Substitute(suuji, Mid(moji, i, 1), "")
Next
'残った数字部分を表示
myRng.Offset(, 1) = "'" & suuji
Next myRng
Set myRng = Nothing
End Sub
|
|