[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数シートのセルの分割』(マメ)
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%
上記1行目のように、元データを残しつつ、右のエリアにスペースで分割したデータを作成したいのですが、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
再掲です。
>まず、一列のみ、単一シートのみのコードを >作成し、
応用するのは基本ができてからです。 (カエムワセト) 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
右のエリアにスペースで分割したデータを作成するパターンです。
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.