[[20150825115928]]　『複数シートのセルの分割』（マメ）　ページの最後に飛ぶ

『複数シートのセルの分割』（マメ）

　A　　　　　B　　　C　　　　D
1 ZZ 30% YY 30% XX 30% WW 10%
2 YY 80% XX 20%
3 W 90% ZZ 10%
4 XX 60% YY 30% ZZ 10%

等のデータが複数シートに入っております。
全てのシートで、範囲内のセルをスペースで分割して、
　A　B　　C　D　　E　F　　 G　H
1 ZZ 30% YY 30% XX 30% WW 10%
2 YY 80% XX 20%
3 W 90% ZZ 10%
4 XX 60% YY 30% ZZ 10%

とするか、または、
　A　　　　　B　　　C　　　　D　　 | E　F　　G　H
1 ZZ 30% YY 30% XX 30% WW 10% | ZZ 30% YY 30% ...
2 YY 80% XX 20%
3 W 90% ZZ 10%
4 XX 60% YY 30% ZZ 10%

上記１行目のように、元データを残しつつ、右のエリアにスペースで分割したデータを作成したいのですが、VBAでの一括作業は可能でしょうか？

＜使用 Excel：unknown、使用 OS：unknown ＞

 データ、区切り位置でやればいいと思うよ。

区切り位置は、１列づつ作業しなければならず、また
複数シートにまたがっていると、出来ないんです。。。（ ; ; ）

（マメ） 2015/08/25(火) 12:39

 VBAですよね？
 まず、一列のみ、単一シートのみのコードを
 作成し、それを発展させて複数列、複数シートに適用するコードに
 変えていけばいいと思います。
（カエムワセト） 2015/08/25(火) 13:41

 確認です。

 シートレイアウトがよくわからないのですが、たとえば元データの一行目は

    |[A]    |[B]    |[C]    |[D]    
 [1]|ZZ 30% |YY 30% |XX 30% |WW 10%

 こんなように入っていて、処理後は

    |[A]|[B]|[C]|[D]|[E]|[F]|[G]|[H]
 [1]|ZZ |30%|YY |30%|XX |30%|WW |10%

 こういうことですか？

（β） 2015/08/25(火) 13:55

βさん
その通りです。
それが複数シートにあり、A1からスタートは共通なのですが、データの入っている行数、列数共にシートによりバラバラです。
追加になってしまいますが、出来れば"%"も分割して別セルに表示させたいです。
（マメ） 2015/08/25(火) 14:09

 再掲です。

 >まず、一列のみ、単一シートのみのコードを
 >作成し、

 応用するのは基本ができてからです。
（カエムワセト） 2015/08/25(火) 14:13

 一例です。

 元データが上書きされてしまうというのが、ちょっと使いづらい仕様かもしれません。
 シートの下のほうの領域に展開するほうがいいかもしれませんね。

 Sub Test()
    Dim w As Variant
    Dim v As Variant
    Dim x As Long
    Dim c As Range
    Dim sh As Worksheet
    Dim cols As Long

    Application.ScreenUpdating = False

    For Each sh In Worksheets
        With sh.Range("A1").CurrentRegion
            cols = .Columns.Count
            ReDim v(1 To .Rows.Count, 1 To 1)
            x = 0
            For Each c In .Columns(1).Cells
                x = x + 1
                c.Resize(, cols).Replace What:="%", Replacement:=" %", LookAt:=xlPart
                w = WorksheetFunction.Transpose(WorksheetFunction.Transpose(c.Resize(, cols)))
                v(x, 1) = Join(w, " ")
            Next

            .ClearContents
            .Range("A1").Resize(UBound(v, 1)).Value = v
            .Range("A1").CurrentRegion.TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
                            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True
        End With
    Next

 End Sub

（β） 2015/08/25(火) 14:26

希望通りの形式で分割出来ました！！
ありがとうございます！！！
本当にありがとうございました！！
（マメ） 2015/08/25(火) 14:59

こんにちは

右のエリアにスペースで分割したデータを作成するパターンです。

Sub test()

    Dim s   As Worksheet
    Dim i   As Long
    Dim j   As Long
    Dim k   As Long
    Dim r   As Range

    Application.ScreenUpdating = False
    For Each s In Worksheets
        k = 1
        Set r = s.Range("A1").CurrentRegion
        r.Replace What:="%", Replacement:=" %", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        j = r.Columns.Count
        For i = 1 To j
            r.Columns(i).Copy s.Cells(1, j + k)
            s.Columns(j + k).TextToColumns Destination:=s.Cells(1, j + k), DataType:=xlDelimited, _
                            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True
            k = k + 3
        Next
    Next
    Application.ScreenUpdating = True
End Sub

（ウッシ） 2015/08/25(火) 15:01

コメント返信：

[ 一覧(最新更新順) ]

[[20150825115928]] 『複数シートのセルの分割』（マメ） ページの最後に飛ぶ

[[20150825115928]]　『複数シートのセルの分割』（マメ）　ページの最後に飛ぶ