|
▼ハチ さん:
ご教示有難うございました。
参考にさせていただき、以下のコードで無事に目的を達成できました。
力技ですが、1000行で30秒ほどで終わりましたので、自分的にはよしとします。
Sub 番号検出()
Dim Row, Row2, i, Code As Long
Dim Bangou As String
Dim buf As Variant
Application.ScreenUpdating = False
For Row = 2 To 1000
ThisWorkbook.Sheets("元データ").Activate
If Cells(Row, 5).Value Like "*[A-Z][A-Z]#######*" Then
Code = 1
GoSub 文字列切り出し
GoSub 番号書き出し
ElseIf Cells(Row, 5).Value Like "*##########*" Then
Code = 2
GoSub 文字列切り出し
GoSub 番号書き出し
End If
Next
MsgBox ("番号の書き出しが終わりました")
Application.ScreenUpdating = True
Exit Sub
文字列切り出し:
For i = 1 To Len(Cells(Row, 5).Value)
If Code = 1 Then
buf = Mid(Cells(Row, 5).Value, i, 9)
If buf Like "[A-Z][A-Z]#######" Then
Bangou = buf
Exit For
End If
ElseIf Code = 2 Then
buf = Mid(Cells(Row, 5).Value, i, 10)
If buf Like "##########" Then
Bangou = buf
Exit For
End If
End If
Next
Return
番号書き出し:
ThisWorkbook.Sheets("Sheet2").Activate
For Row2 = 1 To 1000
If Cells(Row2, 1) = "" Then
Cells(Row2, 1) = Bangou
Bangou = ""
End If
Next
Return
End Sub
|
|