dポイントプレゼントキャンペーン実施中!

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

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


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

2.連続した3桁の数字のみを抜き出してB列に入力する
741
154
151
154
743
743
111

よろしくお願いします。

A 回答 (2件)

#1です。


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

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
    • good
    • 0
この回答へのお礼

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

お礼日時:2007/07/07 16:10

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



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
    • good
    • 0
この回答へのお礼

sacchi_julです。

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

お礼日時:2007/07/07 16:07

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!