エクセルで連続した数字を抜き出す

質問

エクセルでの作業で困っています。

エクセルのある列からデータを取得して、その中から連続した３桁の数字のみを抜き出して隣の列に入力するという作業を行っています。
しかし、大変量が多いので早くできるようにマクロで行いたいのですが、コーディングの仕方がわかりません。
どなたか、ご教授願えないでしょうか？
よろしくお願いします。

例
１．Ａ列の以下データを取得する
S741T
154D_D15.5_D13
151ZZ_D18.5_D16
S154ZZZ3
S743DZ
743CHR
S111D_cov

２．連続した３桁の数字のみを抜き出してＢ列に入力する
741
154
151
154
743
743
111

よろしくお願いします。

回答No.2

merlionXX · ベストアンサー

#1です。
質問のサンプルでは、先程ので大丈夫でしたが、仮に
S15AB422XXXのような、連続した３桁の数字の前にも数字がある場合はただしく抜き出せないので修正しました。

Sub TEST02()
Dim x As Integer, i As Integer, F As Integer, n As Long, s As String
Dim base As Range

With ActiveSheet
Set base = .Range("A1") '基準点
Do Until base.Offset(n) = "" '基準点以下にデータのある限り続ける
s = ""
F = 0
x = Len(base.Offset(n)) '文字数取得
For i = 1 To x '1から文字数分まで
If IsNumeric(Mid(base.Offset(n), i, 1)) Then '数字だったら
s = s & Mid(base.Offset(n), i, 1) '控えておく
F = F + 1 '数字カウント
If F = 3 Then '数字カウント3で
.Cells(n + 1, 2).NumberFormatLocal = "@" '頭の0が消えないよう文字列に
.Cells(n + 1, 2) = s '隣に代入
Exit For '抜ける
End If
Else
s = ""
F = 0
End If
Next '繰り返し
n = n + 1 'カウント
Loop '繰り返し
End With
End Sub

お礼

sacchi_julです。
修正版まで考えていただき、ありがとうございます。
merlionXXさんの想定されたケースまでは、想定していませんでいた。
確かに、こういたデータを扱うケースもあると思います。
助かりました。
ありがとうございました。

回答No.1

merlionXX

こんな感じででしょうか。

Sub TEST01()
Dim x As Integer, i As Integer, F As Integer, n As Long, s As String
Dim base As Range

With ActiveSheet
Set base = .Range("A1") '基準点
Do Until base.Offset(n) = "" '基準点以下にデータのある限り続ける
s = ""
F = 0
x = Len(base.Offset(n)) '文字数取得
For i = 1 To x '1から文字数分まで
If IsNumeric(Mid(base.Offset(n), i, 1)) Then '数字だったら
s = s & Mid(base.Offset(n), i, 1) '控えておく
F = F + 1 '数字カウント
If F = 3 Then '数字カウント3で
.Cells(n + 1, 2).NumberFormatLocal = "@" '頭の0が消えないよう文字列に
.Cells(n + 1, 2) = s '隣に代入
Exit For '抜ける
End If
End If
Next '繰り返し
n = n + 1 'カウント
Loop '繰り返し
End With
End Sub

お礼

sacchi_julです。

お早いお返事ありがとうございます。
大変助かりました！