[[20170209132520]]　『VBAでセルの分割』（関数がにがて）　ページの最後に飛ぶ

『VBAでセルの分割』（関数がにがて）

 こんにちは
 いつもお世話になっております。

 どうしたら良いのか、どこが間違っているのかを教えていただきたいです。

 仕事で大量の車両をExcelで管理しております。
 入れ替えなどがあった場合、車両の情報が届き一覧表に入力するのですが、
 その際、後々の工程を考慮し車両番号を分割しています。
 少数なら区切りで行うのですが大量かつ文字数が違う為、VBAで何とかしよう と考えています。

 発行用シートのF列2行目から下にに車両番号が入る状態で、

 Sub 車番分割()

    Dim 数 As Long
    For 数 = 2 To Worksheets("発行用").Range("A2").End(xlDown)
    If Worksheets("発行用").Cells(数, 1).Value = "" Then Exit For

        Worksheets("発行用").Cells(数, 6).Select
        Selection.TextToColumns Destination:=Worksheets("発行用").Cells(数, 6), DataType:=xlFixedWidth, _
        FieldInfo:=ArrayArray(Array(0, 1), Array(4, 1), Array(7, 1), Array(9, 2)),TrailingMinusNumbers:=True

    Next

 End Sub
 と組んでみました。
 が、この場合「練馬500あ9999」ならば分割できるのですが、「つくば300あ11」など
 文字数が違う場合は正しく分割されません。
 FieldInfo:=ArrayArray(Array(0, 1), Array(4, 1), Array(7, 1), Array(9, 2))
 をどうにかすればよいとは考えるのですが、どうしたら良いのかわかりません。
 どなたか、ご教授願います。
 そしてもう一つ質問があります。
 上記のVBAでは「練馬500あ9999」と同じ文字数の物だけを集めて行っても
 途中から分割してくれないエラー？の状態になり、進んまない時があります。
 色々なパターンを試したのですが（文字列にしてみたり…）上手く行く時と行かない時があり
 頭を抱えています。
 なぜかを教えていただけるととても助かります。

 よろしくお願いいたします。

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

TextToColumnsメソッドは、特定の区切り文字がある場合か、固定長で区切れる場合にしか使えないかと思います。実際のデータは区切り文字の無い可変長のようですから、独自ロジックを書くしかないでしょうね。

とりあえず、1文字ずつ数字かその他かを調べ、切り替わりで抜き出していく例なぞ。
元の文字列を上書きして消すのは、後からチェックする際に困りそうだと思ったので、G列以降に出力してみました。
上書きしたいならば、"G"の部分を"F"に変えてください。

 Sub test()
    Dim i As Long
    Dim j As Long
    Dim ip As Long
    Dim iSt As Long
    Dim iLen As Long
    Dim cw As String
    Dim cDim(3) As String

    With Sheets("発行用")
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            cw = .Cells(i, "F").Value
            If cw <> "" Then
                ip = 0
                iSt = 1
                iLen = Len(cw)
                For j = 2 To iLen
                    If Mid(cw, j, 1) Like "[0-9]" = Array(True, False)(ip Mod 2) Then
                        cDim(ip) = Mid(cw, iSt, j - iSt)
                        iSt = j
                        ip = ip + 1
                    End If
                Next j
                cDim(ip) = Mid(cw, iSt)
            End If
            .Cells(i, "G").Resize(1, 4).Value = cDim()
        Next i
    End With
 End Sub
（???） 2017/02/09(木) 14:27

 ???さんと同じく F列文字列をG列以降に分解する一例です。

 Sub Sample()
    Dim d As Object
    Dim c As Range
    Dim re As Object
    Dim x As Long

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "\d+|\D+"
    re.Global = True

    With Sheets("発行用")
        For Each c In .Range("F2", .Range("F" & Rows.Count).End(xlUp))
            x = 0
            For Each d In re.Execute(c.Value)
                x = x + 1
                c.Offset(, x).Value = d.Value
            Next
        Next
    End With

 End Sub

（β） 2017/02/09(木) 15:00

 Sub main()
    Dim c As Range, m As String, i As Long, j As Long
    For Each c In Range("A:A").Cells.SpecialCells(xlCellTypeConstants)
        m = c.Offset(, 5).Value
        j = 0
        For i = 1 To Len(m) - 1
            c.Offset(, 6 + j).Value = c.Offset(, 6 + j).Value & Mid(m, i, 1)
            If (Mid(m, i, 1) Like "[0-9]") <> (Mid(m, i + 1, 1) Like "[0-9]") Then j = j + 1
        Next i
        c.Offset(, 6 + j).Value = c.Offset(, 6 + j).Value & Right(m, 1)
    Next c
End Sub
（mm） 2017/02/09(木) 15:43

???さん、βさん、mmさん
ありがとうございます。
時間をみて全て試してみます。
また、質問などありましたらよろしくお願いいたします。
（関数がにがて） 2017/02/10(金) 11:25

コメント返信：

[ 一覧(最新更新順) ]

[[20170209132520]] 『VBAでセルの分割』（関数がにがて） ページの最後に飛ぶ

[[20170209132520]]　『VBAでセルの分割』（関数がにがて）　ページの最後に飛ぶ