[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『横並びのデータを別シートで縦並びに整形したい』（とまと）
はじめまして。
関数もマクロも初心者で、自分で調べながらやってみたのですがなかなか解決に至らず、こちらで助言をいただきたく書き込みさせていきます。
マスタとしているシートで横並びにデータが入力されており、
別の抽出用シートに縦並びに反映させたく思います。
なお、マスタ自体は別ブックで管理しており、VBAでマスタの該当シートを抽出用ブックの指定シートにコピーするようにしています。マスタを更新したら、随時マクロを実行してシートを上書きしています。
エクセルのレイアウトは以下の通りです。
＜マスタ＞
A列 B列 C列 D列 …
1 日付
2 イベント名 イベント場所 備考
3 営業所あ aaa bbb ccc
4 営業所い ddd eee fff
5 営業所う ggg hhh iii
⇒マスタは上記のような形で、次の日付がE列1行目のセルに入力されており、横に順次増えていきます。
＜抽出＞
A列 B列 C列 D列 …
1 日付 日付
2 営業所あ イベント名 aaa イベント名
3 イベント場所 bbb イベント場所
4 備考 ccc 備考
5 営業所い イベント名 ddd イベント名
6 イベント場所 eee イベント場所
7 備考 fff 備考
⇒抽出もマスタ同様に横に増える形で、マスタの2行目横軸を縦にして、それぞれデータを反映させていきます。
データが随時増えていくので、関数をコピペするのが一番やりやすいかなと思い、TRANSPOSEやOFFSET、INDEXなど試してみたのですが連続コピーするとどうしても列がずれてしまい、うまくいきません。
こういった場合の最適な方法をご教授いただければ幸いです。
よろしくお願いいたします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
いじらない方がいいと思う。
ご自分で提案したレイアウトは、後々泣きを見ます。
データとして役に立ちませんから却下ですね。
実際はどうなっているのは解りませんが。
（まとま） 2022/03/08(火) 19:55
テーブルの確認のお手伝いです。 レイアウトの認識が違うと後で手間なので、確認を
確認1. 各営業所におけるイベント開催日は、同日なのですか？
確認2. 下記の認識であってますか？
（あみな） 2022/03/08(火) 21:17
＜マスタ＞
|[A] |[B] |[C] |[D] |[E] |[F] |[G]
[1]| |2022/3/8 | | |2022/3/15 | |
[2]| |イベント名|イベント場所|備考|イベント名|イベント場所|備考
[3]|営業所あ|aaa1 |bbb1 |ccc1|aaa2 |bbb2 |ccc2
[4]|営業所い|ddd1 |eee1 |fff1|ddd2 |eee2 |fff2
[5]|営業所う|ggg1 |hhh1 |iii1|ggg2 |hhh2 |iii2
＜抽出＞
|[A] |[B] |[C] |[D] |[E]
[1]| |2022/3/8 | |2022/3/15 |
[2]|営業所あ|イベント名 |aaa1|イベント名 |aaa2
[3]| |イベント場所|bbb1|イベント場所|bbb2
[4]| |備考 |ccc1|備考 |ccc2
[5]|営業所い|イベント名 |ddd1|イベント名 |ddd2
[6]| |イベント場所|eee1|イベント場所|eee2
[7]| |備考 |fff1|備考 |fff2
これであってますか？
（あみな） 2022/03/08(火) 21:29
確認1.
各営業所におけるイベント開催日は、同日なのですか？ →同日ではなくバラバラです。 確認2. 下記の認識であってますか？ →いただいた図の通りです。
よろしくお願いいたします。
（とまと） 2022/03/08(火) 22:58
Sub test()
Dim wsF As Worksheet
Dim wsT As Worksheet
Dim r As Range
Dim y As Long, x As Long
Dim w()
Dim j As Long, k As Long
Dim m As Long, n As Long
Set wsF = Worksheets("Master")
Set wsT = Worksheets("抽出")
Set r = wsF.Cells(1).CurrentRegion
y = WorksheetFunction.CountA(r.Columns(1))
x = WorksheetFunction.Count(r.Rows(1))
ReDim w(1 To 1 + y * 3, 1 To 1 + x * 2)
For k = 2 To r.Columns.Count Step 3
w(1, k) = r.Cells(1, k).Value
Next
m = 2
For j = 3 To r.Rows.Count
w(m, 1) = r.Cells(j, 1).Value
n = 0
For k = 2 To r.Columns.Count Step 3
n = n + 2
w(m, n) = "イベント名"
w(m, n + 1) = r.Cells(j, k).Value
w(m + 1, n) = "イベント場所"
w(m + 1, n + 1) = r.Cells(j, k + 1).Value
w(m + 2, n) = "備考"
w(m + 2, n + 1) = r.Cells(j, k + 2).Value
Next
m = m + 3
Next
wsT.UsedRange.ClearContents
wsT.Cells(1).Resize(UBound(w, 1), UBound(w, 2)).Value = w
End Sub
（マナ） 2022/03/08(火) 23:07
＞確認1. ＞各営業所におけるイベント開催日は、同日なのですか？ ＞→同日ではなくバラバラです。 ＞確認2. ＞下記の認識であってますか？ ＞→いただいた図の通りです
これって、提示例ではたまたま各営業所が同日にイベント開催しているというレアなケースと解釈すれば良いですか？ その日に開催していない営業所にも見出しは打っても良いのなら。 （マナさんの後で出すのも恐縮ですが。。。）
Sub Macro1()
Dim tbl, op
Dim x As Long, y As Long
Dim r As Long, c As Long, cnt As Long
Dim i As Long, j As Long
tbl = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
y = (UBound(tbl, 1) - 2) * 3 + 1
x = (UBound(tbl, 2) - 1) / 3 * 2 + 1
ReDim op(1 To y, 1 To x)
'イベント(名|場所)・備考
c = 2
For j = 2 To UBound(op, 2)
r = 3
If j Mod 2 = 0 Then
For i = 2 To UBound(op, 1) Step 3
op(i, j) = tbl(2, 2)
op(i + 1, j) = tbl(2, 3)
op(i + 2, j) = tbl(2, 4)
Next i
Else
For i = 2 To UBound(op, 1)
op(i, j) = tbl(r, c + cnt)
If cnt Mod 3 = 2 Then
cnt = 0
r = r + 1
Else
cnt = cnt + 1
End If
Next i
c = c + 3
End If
Next j
'営業所名
cnt = 3
For i = 2 To UBound(op) Step 3
op(i, 1) = tbl(cnt, 1)
cnt = cnt + 1
Next i
'日付
cnt = 2
For j = 2 To UBound(op, 2) Step 2
op(1, j) = tbl(1, cnt)
cnt = cnt + 3
Next j
'書き出し
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Range("A1").Resize(UBound(op), UBound(op, 2)).Value = op
.UsedRange.EntireColumn.AutoFit
End With
End Sub
（三文） 2022/03/08(火) 23:33
ご返信ありがとうございます。
無事思っていた通りの動きで処理できました！
大変感謝しております。お時間割いていただきありがとうございました。
（とまと） 2022/03/10(木) 17:16
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.