エクセル シート内のボックスを縦並びから横並びに

こんにりは、セル操作で一人ではとても無理な事があるので教えて下さい。

上画像のようにデータがA1からD1の範囲にあります。
その状態を１ボックスとするとそのボックスが上から順にならんでいる感じです。
また、B1、C1、D1の位置には文字は入力されていません。

そのA１からD4までを１つのボックス、A5からD8を一つのボックスのように維持したまま、ボックス自体を中にある値ごと下画像のように横並びに変えてきたいのです。

どのボックスも4行4列で、どのボックスにもA1～D4と同じ状態で値が存在します。
それを最下行、最後列までデータが存在する限り繰り返したいです。

私にはちょっと無理なので、具体的にマクロコードを教えて頂ける方、よろしくお願いいたします。

No.5 ベストアンサー 回答者： fujillin 回答日時： 2023/04/05 13:55

No2です。

＞枠線が取り残されてしまうので、枠線も一緒に並び替え
＞するにはどうしたら良いでしょうか？
No2に記したように、Copyメソッドでコピーすれば、セルの情報（色や枠線）もコピーできます。
VBAで個別にチェックして再設定してもできますが、属性の数が多いためそれなりに面倒です。
Copyで一括コピーしてしまう方が簡単でしょう。

ただし、罫線に関しては隣り合うセルの位置関係が部位によって変わってしまうので、どちらのセルに対して罫線が引かれているかによっては、コピーした結果が変わって見える可能性はありますが、元のデータがきちんと作成されていれば、その様なことは発生しないと思います。


以下は、同一シート内に並べ替えたコピーを作成する方法でのごく簡単な例です。
※ コピーは現在の表の下に一時的に作成します。
（元の表が膨大で、この際にシートの行数をオーバーしてしまうような場合にはエラーになります）
※ 直下にコピーを作成する関係から、シート内には他のデータは存在しないものと仮定しています。

※ 元データは削除されますので、コピーシートなどでテストしてください。

Sub Q_13417817()
Dim sRange As Range, dRange As Range
Dim rw As Long, col As Long, maxRow As Long

Set sRange = Range("A1").CurrentRegion
maxRow = sRange.Rows.Count
Set dRange = Cells(maxRow + 1, 1).Resize(sRange.Columns.Count, maxRow)
dRange.Cells.UnMerge

For rw = 1 To sRange.Rows.Count Step 4
For col = 1 To sRange.Columns.Count Step 4
sRange(rw, col).Resize(4, 4).Copy dRange(col, rw)
Next col
Next rw
Rows(1).Resize(maxRow).Delete
End Sub

この回答へのお礼

ありがとうございます。
この通りです、ばっちり出来ました！

お礼日時：2023/04/05 14:11

No.7 回答者： tatsumaru77 回答日時： 2023/04/05 15:15

下記にアップしました。

https://ideone.com/oZ1L7r

線の太さを調整する場合は、以下のようにしてください。

線の太さは、上から細い→太いの順になっています。
以下の変数で調整してください。
①xlThin
②xlMedium
③xlThick

現在は、①と②を使ってます。

以下の２行が線の太さを指定する行です。
.Weight = xlThin '細線
ws.Range(ws.Cells(wrow, wcol), ws.Cells(wrow + 3, wcol + 3)).BorderAround True, xlMedium '太線

この回答へのお礼

再回答いただき、ありがとうございます！
ばっちり出来ました！

お礼日時：2023/04/06 00:58

No.6 回答者： tatsumaru77 回答日時： 2023/04/05 14:01

＞枠線が取り残されてしまうので、枠線も一緒に並び替えするにはどうしたら良いでしょうか？

罫線がよく見えないので確認です。
添付図のレイアウト及び太さで良いですか。
1ブロック内の１行目は、罫線なし。
1ブロック内の上記以外は、1番細い罫線。
1ブロック全体（外枠）は、２番目に太い罫線

この回答へのお礼

ありがとうございます。

A2～D4までに細い枠線を引き
その上でA1～D4に太い枠線を引きました。

それが全てのブロックにある感じです。

お礼日時：2023/04/05 14:11

No.4 回答者： tatsumaru77 回答日時： 2023/04/05 11:26

No3です。

追伸：シートを直接書き換えますので、念のため、シートのバックアップを
とってから、マクロを実行してください。

No.3 回答者： tatsumaru77 回答日時： 2023/04/05 11:24

以下のマクロを標準モジュールに登録してください。

Option Explicit


Public Sub ボックス転置()
Dim ws As Worksheet
Dim rg As Range
Dim maxrow As Long
Dim maxcol As Long
Dim rowb As Long
Dim colb As Long
Dim arr1 As Variant
Dim arr2 As Variant
Set ws = ActiveSheet
Set rg = ws.Range("A1").CurrentRegion
maxrow = rg.Rows.count
maxcol = rg.Columns.count
If maxrow Mod 4 <> 0 Then
MsgBox ("行数が４の倍数でない")
Exit Sub
End If
If maxcol Mod 4 <> 0 Then
MsgBox ("列数が４の倍数でない")
Exit Sub
End If
'セルをarr1に転送
arr1 = rg.Value
ReDim arr2(1 To maxcol, 1 To maxrow)
'arr1からarr2へ転送
For rowb = 1 To maxrow \ 4
For colb = 1 To maxcol \ 4
Call arr_move(rowb, colb, arr1, arr2)
Next
Next
'シートクリア
ws.Cells.ClearContents
'配列2をセルへ転送
ws.Range("A1").Resize(maxcol, maxrow).Value = arr2
End Sub
'ブロック単位でarr1からarr2へ転送
Private Sub arr_move(ByVal rowb As Long, ByVal colb As Long, ByRef arr1 As Variant, ByRef arr2 As Variant)
Dim row1 As Long
Dim row2 As Long
Dim col1 As Long
Dim col2 As Long
Dim r As Long
Dim c As Long
Dim temp As Variant
For r = 1 To 4
For c = 1 To 4
row1 = (rowb - 1) * 4 + r
col1 = (colb - 1) * 4 + c
row2 = (colb - 1) * 4 + r
col2 = (rowb - 1) * 4 + c
arr2(row2, col2) = arr1(row1, col1)
Next
Next
End Sub

この回答へのお礼

こんにちは　回答ありがとうございます。

枠線が取り残されてしまうので、枠線も一緒に並び替えするにはどうしたら良いでしょうか？

お手数をお掛けしますが、よろしくお願いいたします。

お礼日時：2023/04/05 12:08

No.2 回答者： fujillin 回答日時： 2023/04/05 11:16

こんにちは

「4×4セルをひとまとまりとして、行列を入れ替えてコピペする」ようなことを考えればよろしいかと。
関数でも、マクロでも可能と思います。
いずれの場合も、一旦、別シートに並べ替えを作成して、それをそのまま使うか元のシートにコピペし直すなどが簡単そうです。
同じシートの空きセルを利用しても良いですが（＝単純にオフセットするだけ）、多分、別シートの方が考えやすいでしょう。


以下は、いずれも要領のみとなりますが・・
◇関数の場合
元のシートを「Sheet1」とするなら、別シートのA1セルに
=OFFSET(Sheet1!$A$1,INT((COLUMN()-1)/4)*4+MOD(ROW()-1,4),INT((ROW()-1)/4)*4+MOD(COLUMN()-1,4))
を入力して、右方、下方にフィルコピーすれば、基本的に並べ替えて参照が可能です。

※ 関数の場合、空白セルを参照すると、結果の表示がが「0」になります。
　これを防止したければ、
　　if(参照セル="","",参照セル）
　のような式にすることで可能になります。
※ 結果を関数式ではなくしたい場合には、セル全体を「コピー」-「値をペースト」することで固定値に変換できます。


◇マクロを利用する場合
4×4をひとまとめと考えるので、行、列とも4行（列）置きに以下の処理をループすれば良いことになります。
（以下の例は、行変数をrw、列変数をcolとしています）
　SourceSheet.Cells(rw,col).Resize(4,4).Copy　DestSheet.Cells(col,rw)

※ セルの結合があるようなので、あらかじめ、別シート（＝転記先）全体のセル結合を解除した状態にしておく必要があります。
（新規シートを利用すれば、その必要はなくなるでしょう）
※ Copyメソッドなので、（関数とは異なり）結合セルや色の情報もそのままコピーされます。
　元が関数式だったりして、値だけ転記したい場合には、
　　Range2.Value = Range1.Value
　形式で転記すれば、値のみの転記が可能です。

この回答へのお礼

こんにちは、回答ありがとうございます。

関数でも出来るのですね！　
今回は毎日数十の作業があるので、ボタン一発が便利かなと思います

マクロのほうですが、セル結合は無く、背景色が設定されているセルもあるので、それも移動できるのは良いと思いました。

マクロは全くわからないので、ご提示いただいた文は理解できませんが、組み合わせるときっとうまく行くんでしょうね！

いつもありがとうございます。

お礼日時：2023/04/05 13:05

No.1 回答者： tatsumaru77 回答日時： 2023/04/05 06:35

A1～D1のセルは、結合セルでしょうか。

A5～D5のセル、E1～H1のセル等も同様に、結合セルでしょうか。

この回答へのお礼

こんにちは、シート内に結合セルはありません。

お礼日時：2023/04/05 11:09