[[20130625203010]]　『セル内にある顧客IDをセルに振り分けたい』（タバサ）　ページの最後に飛ぶ

『セル内にある顧客IDをセルに振り分けたい』（タバサ）

 セル（Ａ１）に下のように顧客IDが多いときで５０個くらい入っています。
 これを２個目以降「-」で分けられた３桁と８桁にして１０顧客分づつB列からK列まで表示 させるには？
 Ａ１に１５顧客分ならB1：E4に表示されることになります。
 顧客IDとの境目には「、」や空白だったり囲み数字の番号が振ってあったり途中で改行があったりします。
 手入力で３桁８桁をそれぞれコピー貼り付けてましたが、
 多くなるとどこまでコピー貼り付けたのか．．．分からなくなってしまうのです。
     Ａ　　　　　　　　　　　　　　　　　　　　　　　　Ｂ　　　　　Ｃ
 ?@111-31111111、?A222-22922222、?B333-3252　　　　　222	22922222
 4158	（？は囲み数字です。）　　　　　　　　　　　333　　　	32524158

 444-45254444、555-87888888、777-87777777	　　　555	87888888
	                                     　　　　　777	87777777

 999-85888888　222-85888888　333-36
 333333　777-78777777                  	　　　　　　　222	85888888
	                                 　　　　　　　333	36333333
	                                  　　　　　　777	78777777
 とにかく今より正確に早くできれば嬉しいです。

 XL2003

 まず「データ」-「区切り位置」「区切り文字」、「スペース」で各顧客毎に分けてみては？

 VBA
 Sub test()
    Dim r As Range, m As Object, temp, i As Long, n As Long
    With CreateObject("VBScript.RegExp")
        .Global = True
        For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
            temp = Application.Trim(r.Value)
            .Pattern = "\n+"
            temp = .Replace(temp, "")
            .Pattern = "\D?(\d{3})\-(\d+ *\d+)(?=(\b|、))"
            If .test(temp) Then
                If .Execute(temp).Count > 1 Then
                    For i = 1 To .Execute(temp).Count - 1
                        n = n + 1
                        Cells(n, 2).Resize(, 2).Value = _
                        Array(.Execute(temp)(i).submatches(0), _
                        Replace(.Execute(temp)(i).submatches(1), " ", ""))
                    Next
                End If
            End If
        Next
    End With
End Sub
(seiya)

　こんばんは　seiya様

 試しに２０こ入力してみたら！すごい！
 今まで３０分くらいかけてやってたのに！

 ところで１０こ１０こ．．．ってのは無理でしょうか？
 でなければD列に連番を振ろうかなと考えています。　　　タバサ

 > ところで１０こ１０こ．．．ってのは無理でしょうか？
 どういうこと？
 (seiya)

 ごめんなさい、説明不足ですね。

 たとえばA1に444-45254444こんなのが21顧客分あったとします。
 それをB1：C10に10顧客分、D1：E10までに10顧客分が表示させられたら嬉しいです。

 "?@111-31111111、?A222-22922222、?B333-3252
4158　444-45254444、555-87888888、777-7777666　444-45254444、555-87888888、
777-87777777　999-85888888　222-85888888　333-36333333　777-78777777　
999-85888888　222-85888888　333-36333333　777-78777777　555-0202354　?@111-31111111、?A222-22922222、?B333-32524158"
　これがこうなればいいな．．．です。
 222	22922222	333	36333333
333	32524158	777	78777777
444	45254444	999	85888888
555	87888888	222	85888888
777	7777666　　	333	36333333
444	45254444	777	78777777
555	87888888	555	202354
777	87777777	111	31111111
999	85888888	222	22922222
222	85888888	333	32524158

 わかりにくいかと思います。
 でも思いがけず本当に早く出来るのでもっと贅沢になってきました！　　　タバサ

 これで...

 Sub test()
    Dim r As Range, m As Object, temp, i As Long, n As Long, t As Long
    With CreateObject("VBScript.RegExp")
        .Global = True
        t = 2
        For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
            temp = Application.Trim(r.Value)
            .Pattern = "\n+"
            temp = .Replace(temp, "")
            .Pattern = "\D?(\d{3})\-(\d+ *\d+)(?=(\b|、))"
            If .test(temp) Then
                If .Execute(temp).Count > 1 Then
                    Set m = .Execute(temp)
                    For i = 1 To m.Count - 1
                        n = n + 1
                        If n > 10 Then n = 1: t = t + 2
                        Cells(n, t).Resize(, 2).Value = _
                        Array(m(i).submatches(0), _
                        Replace(m(i).submatches(1), " ", ""))
                    Next
                End If
            End If
        Next
    End With
End Sub
(seiya)

 seiya様
 ありがとうございました。
 ひとつひとつ入力するってもう今では考えられません。ありえません！　タバサ

コメント返信：

[ 一覧(最新更新順) ]

[[20130625203010]] 『セル内にある顧客IDをセルに振り分けたい』（タバサ） ページの最後に飛ぶ

[[20130625203010]]　『セル内にある顧客IDをセルに振り分けたい』（タバサ）　ページの最後に飛ぶ