Excel:文字と数字の間に数字を追加するマクロ。

こんばんは、よろしくお願いします。

ｃｓｖのデータで数字とかなが下記のようなデータがあります。

※処理前　頭の数字以降は、文字と数字がランダムなデータ。全体の文字数もランダム
900000000000085600000008～0051038901フ（半角）～
20000000000008560000008～0051038902サ～

※処理後
900000000000085600000008～0000510389フ～
20000000000008560000008～0000510389サ～

というようなデータの
半角カナの前の数字2ケタを削除し、10桁前に00を追加するようなマクロをExceｌで作成したいのですが、
カナの前の数字の桁数が一定ではないこと、またカナの前の数字の桁数が多いため（40桁以上）
のため指数表記になってしまう。
という、2点で困っています。

データ数が多くなることを考えると、前から1文字ずつ検索し、
判断していくのは、難しいかなと考えております。

Val関数で、取得しようとしたのですが、指数表記で上手く行きませんでした。

どのように、処理すればよろしいでしょうか。
お教え下さい。

No.2 ベストアンサー 回答者： tom04 回答日時： 2011/10/17 23:50

こんばんは！

外していたらごめんなさい。

データはA列の1行目からあるとします。
C列を作業用の列として使っていますので、C列にはデーががないという前提です。

Sub test()
Dim i, k As Long
Dim str, buf As String
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To Len(Cells(i, 1))
str = Mid(Cells(i, 1), k, 1)
If str Like "[ア-ン]" Then
buf = Mid(Cells(i, 1), k - 10, 10)
With Cells(i, 3)
.Value = "00" & Mid(buf, 1, 8)
.NumberFormatLocal = "@"
End With
Cells(i, 2) = Replace(Cells(i, 1), buf, Cells(i, 3))
Exit For
End If
buf = ""
Next k
Next i
Application.ScreenUpdating = True
Columns(3).ClearContents
End Sub

こんなかんじではどうでしょうか？

希望通りにならなかったらごめんなさいね。m(_ _)m

No.5 回答者： tom04 回答日時： 2011/10/18 20:56

No.2・3です！

何度もごめんなさい。

No.3の訂正分で

With Cells(i, 3)
.Value = "00" & Mid(buf, 1, 8)
.NumberFormatLocal = "0000000000"
End With
は無視してください。
仮に　「0012345678」と10桁表示だとしても、見た目だけの表示で、
実際のデータは「12345678」の8桁となってしまいますので、ご希望通りにならないと思います。

後者の

With Cells(i, 3)
.NumberFormatLocal = "@"
.Value = "00" & Mid(buf, 1, 8)
End With

にしてください。
これなら表示形式を文字列にした後に、10桁数値のデータにしていますので、
大丈夫だと思います。

何度も失礼しました。m(_ _)m

No.4 回答者： ki-aaa 回答日時： 2011/10/18 11:39

'ちょっとだけ処理を簡略化してあります

'
'>半角カナの前の →　数字以外の前の
'ひとつのデータでは、一回のみの処理
'条件が違うのであれば、補足をお願いします。
'A1セルのデータをA2セルに出しています。

Sub test1()

Dim i As Long
Dim aaa As String
Dim sss As String
Dim re As RegExp '（正規表現の抜き出しオブジェクト）
Dim mc As MatchCollection '（マッチしたデータ達を保持する）

Set re = CreateObject("VBScript.RegExp")

re.Global = True
re.Pattern = "[^0-9]+" '数字の0～9以外の集まり

aaa = Range("A1").Value
Set mc = re.Execute(aaa) '数字の0～9以外の集まりを取り出す。
i = mc(0).FirstIndex '数字の0～9以外の集まりの位置
If i > 10 Then
sss = Left$(aaa, i - 10) & "00" 'カナの10桁前に00を追加
sss = sss & Mid$(aaa, i - 9, 8) '次の8桁
Range("A2").Value = sss & Mid$(aaa, i + 1) 'カナ以降
End If

Set re = Nothing
Set mc = Nothing

End Sub

No.3 回答者： tom04 回答日時： 2011/10/18 08:11

No.2です！

たびたびごめんなさい。
前回のコードで
（ア-ンは半角文字に！）
それから

＞With Cells(i, 3)
＞.Value = "00" & Mid(buf, 1, 8)
＞.NumberFormatLocal = "@"
＞End With
の部分を
With Cells(i, 3)
.Value = "00" & Mid(buf, 1, 8)
.NumberFormatLocal = "0000000000"
End With

または
With Cells(i, 3)
.NumberFormatLocal = "@"
.Value = "00" & Mid(buf, 1, 8)
End With

に訂正してください。
そうでないと8桁前の「00」が表示されないと思います。

検証せずに投稿してごめんなさいね。m(__)m

No.1 回答者： keithin 回答日時： 2011/10/17 23:30

ぶっちゃけ先頭から１文字ずつ検査していった方が，簡単なマクロで確実に結果が得られると思います。

が，そうしたくないという事なので。

＃簡単のため１列データとしていますが，実際のデータの姿に併せて適宜修正してください
＃処理後の結果をどうしたいのか不明ですが，簡単のためセルに書き出しています。ご質問の本筋とは無関係の部分なので，適宜修正してください。

サンプル：
Sub macro1()
　Dim buf As String
　Dim res As Long
　Dim i As Integer
　Dim n As Long
　Dim s, p, k


　Open "c:\test\test.csv" For Input As #1
　Do Until EOF(1)
　　Input #1, buf
　　s = buf

　’数字を除去
　　For i = 0 To 9
　　　s = Application.Substitute(s, i, "")
　　Next i

　’半角カタカナを検出
　　p = 1
　　Do Until p >= Len(s)
　　　If Mid(s, p, 1) Like "[ヲ-ン]" Then　　’半角カタカナ。
　　　　k = InStr(1, buf, Mid(s, p, 1))
　
　　　’置換
　　　　buf = Application.Replace(buf, k - 2, 2, "")
　　　　buf = Application.Replace(buf, k - 10, 0, "00")
　　　　Exit Do
　　　End If
　　　p = p + 1
　　Loop
　　n = n + 1
　　Cells(n, "A") = buf
　Loop
　Close #1
End Sub

この回答へのお礼

ありがとうございました。

お礼日時：2011/10/18 22:46