VBA練習問題
VBA100本ノック 34本目:配列の左右回転

VBAを100本の練習問題で鍛えます
公開日:2020-11-27 最終更新日:2021-01-13

VBA100本ノック 34本目:配列の左右回転


2次元配列を、左に90度回転または右90度回転する問題です。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。


出題

出題ツイートへのリンク

#VBA100本ノック 34本目
今回は2次元配列を使った頭の体操です。
2次元配列と回転方向を引数で受け取り、以下の変換後の配列を返すFunctionを作成してください。
回転方向は2種類
・右90度回転
・左90度回転
※引数のデータ型、指定方法は任意
※回転サンプルは画像を参照

マクロ VBA 100本ノック


VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。


他の人の回答および解説を見て、書いたVBAを見直してみましょう。


頂いた回答

解説

セルは2次元配列になっています。
VBAでは2次元配列を扱う事は多くなるので、2次元配列の扱いには慣れておきたいところです。
ただし今回のような回転をさせることはほとんど無く、大抵はTRANSPOSE関数の縦横入替で事足りるでしょう。
あくまで、ある規則の元でセル位置を動かす練習です。

Function VBA100_34_01(ByRef aAry, ByVal 左or右 As String) As Variant
  Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
  LB1 = LBound(aAry, 1): UB1 = UBound(aAry, 1)
  LB2 = LBound(aAry, 2): UB2 = UBound(aAry, 2)
  
  Dim oAry()
  ReDim oAry(LB2 To UB2, LB1 To UB1)
  
  Dim i As Long, j As Long
  For i = LB1 To UB1
    For j = LB2 To UB2
      Select Case 左or右
        Case "左"
          oAry(UB2 + LB2 - j, i) = aAry(i, j)
        Case "右"
          oAry(j, UB1 + LB1 - i) = aAry(i, j)
        Case Else
          MsgBox 左or右 & vbLf & "この指定はない"
          Exit Function
      End Select
    Next
  Next
  
  VBA100_34_01 = oAry
End Function


これと同じようなVBAを書いた人の中には、2重ループの中の条件分岐を何とかしたいと思った人もいるかもしれません。
よほど大きい配列でない限りは構わないと思いますが、練習としてもう少し工夫してみたいと思います。
このあたりについては、記事補足に掲載しました。


補足

まず配列の次元は、1次元と2次元の要素数を反対にするだけです。
3*4→4*3

左回転の場合の位置の移動は、
1,1 → 4,1
1,2 → 3,1
1,3 → 2,1
1,4 → 1,1
2,1 → 4,2
2,2 → 3,2
2,3 → 2,2
2,4 → 1,2
3,1 → 4,3
3,2 → 3,3
3,3 → 2,3
3,4 → 1,3
1次元の数値が2次元の数値へ、2次元の数値は大小を反転させて1次元の数値にすることになります。
同様に右回転も変換を考えて、そして左右回転で分岐させたものが先のVBAになります。

2重ループの中の条件分岐を無くしたいと思った人もいるかもしれません。
もちろん条件分岐をループの外に出して、それぞれの条件内でループさせるだけでも良いです。

2重ループの記述は一か所にして、かつ、ループ内で分岐させない工夫もできます。
また、そもそもプロシージャーを分けてしまうという考え方もあります。


ループ内の条件分岐を無くす
数式をゴチャゴチャやればできると思いますが、こういう時の簡単な方法でやってみます。
oAry(UB2 + LB2 - j, i) = aAry(i, j)
oAry(j, UB1 + LB1 - i) = aAry(i, j)
違うのは左辺だけになっているので、違う数式部分を単純に足しちゃいます。
((UB2 + LB2 - j, i) + (j), (i) + (UB1 + LB1 - i)) = aAry(i, j)
そして、各項に0または1をかけて元のそれぞれの数式になるようにすれば、とりあえずは1本化できます。
0または1の変数をLとRとすると、
oAry(((UB2 + LB2 - j) * L) + (j * R), (i * L) + ((UB1 + LB1 - i) * R)) = aAry(i, j)
左回転の時にはL=1:R=0
右回転の時にはL=0:R=1
このようにすると、
左回転なら、
oAry(((UB2 + LB2 - j) * 1) + (j * 0), (i * 1) + ((UB1 + LB1 - i) * 0)) = aAry(i, j)
右回転なら、
oAry(((UB2 + LB2 - j) * 0) + (j * 1), (i * 0) + ((UB1 + LB1 - i) * 1)) = aAry(i, j)
これで元の数式の左右パターンに戻ることになります。

Function VBA100_34_02(ByRef aAry, ByVal 左or右 As String) As Variant
  Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
  LB1 = LBound(aAry, 1): UB1 = UBound(aAry, 1)
  LB2 = LBound(aAry, 2): UB2 = UBound(aAry, 2)
  
  Dim oAry()
  ReDim oAry(LB2 To UB2, LB1 To UB1)
  
  Dim L As Long, R As Long
  Select Case 左or右
    Case "左"
      L = 1: R = 0
    Case "右"
      L = 0: R = 1
    Case Else
      MsgBox 左or右 & vbLf & "この指定はない"
      Exit Function
  End Select
  
  Dim i As Long, j As Long
  For i = LB1 To UB1
    For j = LB2 To UB2
      oAry(((UB2 + LB2 - j) * L) + (j * R), (i * L) + ((UB1 + LB1 - i) * R)) = aAry(i, j)
    Next
  Next
  
  VBA100_34_02 = oAry
End Function

このような数式の組み立て方はいろいろありますし、引数の与え方でも変わってきます。
ただし、こういうのは作るのは良いのですが、後で見た時に理解するのが大変ですね。
あくまで頭の体操だと思って、いろいろ挑戦してみるのは良いと思います。


プロシージャーを別々にする
そもそもプロシージャーを分割して、それを呼び出す関数を作成すれば、
引数で変えることもできますし、直接呼び出す事も出来ます。
※両方使えるようにする事が良いかどうかは作成するシステムによると思いますが。

Function VBA100_34_03(ByRef aAry, ByVal 左or右 As String) As Variant
  Select Case 左or右
    Case "左"
      VBA100_34_03 = 配列左回転(aAry)
    Case "右"
      VBA100_34_03 = 配列右回転(aAry)
    Case Else
      MsgBox 左or右 & vbLf & "この指定はない"
  End Select
End Function

Function 配列左回転(ByRef aAry) As Variant
  Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
  LB1 = LBound(aAry, 1): UB1 = UBound(aAry, 1)
  LB2 = LBound(aAry, 2): UB2 = UBound(aAry, 2)
  
  Dim oAry()
  ReDim oAry(LB2 To UB2, LB1 To UB1)
  
  Dim i As Long, j As Long
  For i = LB1 To UB1
    For j = LB2 To UB2
      oAry(UB2 + LB2 - j, i) = aAry(i, j)
    Next
  Next
  配列左回転 = oAry
End Function

Function 配列右回転(ByRef aAry) As Variant
  Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
  LB1 = LBound(aAry, 1): UB1 = UBound(aAry, 1)
  LB2 = LBound(aAry, 2): UB2 = UBound(aAry, 2)
  
  Dim oAry()
  ReDim oAry(LB2 To UB2, LB1 To UB1)
  
  Dim i As Long, j As Long
  For i = LB1 To UB1
    For j = LB2 To UB2
      oAry(j, UB1 + LB1 - i) = aAry(i, j)
    Next
  Next
  配列右回転 = oAry
End Function


サイト内関連ページ

第105回.Callステートメント
・Callステートメント ・Callステートメントの使用例 ・同じことは2度書かない ・プロシージャーの分割について
第106回.Functionプロシージャー
プログラム(マクロVBA)内で特定の処理を実行し値を返すプロシージャーです。これはつまり、Functionプロシージャーで独自の関数をつくれるということです。Subプロシージャーとの違いは、値を返すか返さないかの違いです。
第107回.プロシージャーの引数
・引数の構文 ・引数の使用例 ・引数について
第111回.静的配列
・配列とは ・静的配列と動的配列 ・配列の宣言 ・多次元配列 ・要素の下限の変更 ・配列について
第112回.動的配列(ReDim)
・ReDimステートメント ・要素数の変更について ・配列について
第114回.セル範囲⇔配列(マクロVBA高速化必須テクニック)
・セル範囲⇔配列の基本VBA ・使用例 ・配列およびマクロVBAの高速化に関するページ




同じテーマ「VBA100本ノック」の記事

31本目:入力規則
32本目:Excel終了とテキストファイル出力
33本目:マクロ記録の改修
34本目:配列の左右回転
35本目:条件付き書式
36本目:列の並べ替え
37本目:グラフの色設定
38本目:1シートを複数シートに振り分け
39本目:数値リストの統合(マージ)
40本目:複数ブックの統合
41本目:暗算練習アプリ


新着記事NEW ・・・新着記事一覧を見る

TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.メッセージボックス(MsgBox関数)|VBA入門
9.条件分岐(Select Case)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。


このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ