エクセル小僧：入れ子になっている1次元配列を2次元配列に変換

VBAマクロで、入れ子になっている1次元配列を2次元配列に変換し、ワークシート上に縦方向
に展開した後、横方向に転置するというのをやってみました。

ワークシートは、こんな感じ。



【参考】
Arrayのネスト2次元にした配列を、3行3列のセル範囲に一括転送したい
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14152979474

VBAで配列を引数・戻り値にする方法
https://qiita.com/ryosuke0825/items/93eb8a284eb5dba59f29

【マクロ】
Sub 勤務名の転置()
  '【変数】
  Dim 勤務名1(), 勤務名2() As Variant ' 勤務名
  Dim Range1_勤務() As Variant ' 転置前の縦並びの勤務名の開始セル
  Dim RangeName1() As Variant ' 転置前の縦並びの勤務名のRange名
  Dim RangeName2() As Variant ' 転置後の横並びの勤務名のRange名
  Dim Range1_勤務名() As Variant ' 転置前の縦並びの勤務名のRange
  Dim Range2_勤務名() As Variant ' 転置後の横並びの勤務名のRange
  Dim myRow1() As Variant ' 行番号
  Dim myCol1() As Variant ' 列番号
  Dim i, j As Long ' カウンタ
  '【実行コード】
  勤務名1 = Array( _
    Array("A1", "A", "A入", "A1補", "A（喀）", "2西A1", "", "", "", "", "", ""), _
    Array("C1", "C", "C入", "C1ホ", "C1補", "C1入", "受C", "", "", "", "", ""), _
    Array("C2", "C2ホ", "C2補", "", "", "", "", "", "", "", "", ""), _
    Array("夜A", "夜B", "夜C", "夜D", "夜E", "夜F", "夜A補", "夜B補", "夜C補", "夜D補", "夜E補", "夜F補"), _
    Array("休", "リ", "有", "記", "", "", "", "", "", "", "", "") _
  )
  Range1_勤務() = Array("B19", "C19", "D19", "E19", "F19") ' 転置前の縦並びの勤務名の開始セル
  RangeName1 = Array("勤務名_1", "_A1", "_C1", "_C2", "_夜勤", "_休")
  RangeName2 = Array("勤務名_2", "_A1_2", "_C1_2", "_C2_2", "_夜勤_2", "_休_2")
  Range1_勤務名 = Array("B19:F30", "B19:B24", "C19:C25", "D19:D21", "E19:E30", "F19:F22")
  Range2_勤務名 = Array("B32:M36", "B32:G32", "B33:H33", "B34:D34", "B35:M35", "B36:E36")
  ' 入れ子になっている1次元配列から2次元配列への変換
  勤務名2() = myTransArray1(勤務名1())
  ' Debug.Print "勤務名2(1,6)=" & 勤務名2(1, 6)
  Debug.Print "UBound(勤務名2,2)=" & UBound(勤務名2, 2)
  '
  myRow1 = Array(0, 0) ' 行番号配列の初期化
  myCol1 = Array(0, 0) ' 列番号配列の初期化
  ' 転置前後の勤務名の全体のセル範囲の名前付け
  Range(Range1_勤務名(0)).Name = RangeName1(0)
  Range(Range2_勤務名(0)).Name = RangeName2(0)
  ' 転置後の横並びの勤務名のセル範囲の名前付け
  For i = 0 To UBound(勤務名2, 1)
    Range(Range2_勤務名(i + 1)).Name = RangeName2(i + 1) ' 転置後の横並びの勤務名のセル範囲に名前付け
  Next i
  ' 転置前の縦並びの勤務名を各セルに代入
  For i = 0 To UBound(勤務名2, 1)
    myRow1(0) = Range(Range1_勤務(i)).Row
    myCol1(0) = Range(Range1_勤務(i)).Column
    Range(Range1_勤務名(i + 1)).Name = RangeName1(i + 1) ' 転置前の縦並びの勤務名のセル範囲に名前付け
    ' Debug.Print "myRow1(0)=" & myRow1(0)
    ' Debug.Print "myCol1(0)=" & myCol1(0)
    For j = 0 To UBound(勤務名2, 2)
      ActiveSheet.Cells(myRow1(0) + j, myCol1(0)).Value = 勤務名2(i, j)
    Next j
  Next i
  ' 勤務名の転置
  Range(RangeName2(0)).Select
  Selection.FormulaArray = "=TRANSPOSE(" & RangeName1(0) & ")"
End Sub

Function myTransArray1(ByRef myArray1() As Variant) As Variant()
  '【機能】入れ子になっている1次元配列から2次元配列への変換
  '【変数】
  Dim i, j As Long ' 整数
  Dim myArray2() As Variant ' 出力配列
  '【実行コード】
  ReDim myArray2(UBound(myArray1), UBound(myArray1(0)))
  For j = 0 To UBound(myArray1)
    For i = 0 To UBound(myArray1(0))
      myArray2(j, i) = myArray1(j)(i)
    Next i
  Next j
  myTransArray1 = myArray2()
End Function

タグ：Excel エクセル VBA 配列

コメント 2

今年もありがとうございました
新年もよろしくお願いいたします
佳い新年をお迎え下さい


by (。・_・。)２ｋ (2021-12-31 19:38) 

ヤバイぜ！　ありがとうございます(^_0)ノ

(。・_・。)２ｋ さん、
今年もよろしくお願いします。
by cheese999 (2022-01-01 22:10)