Rainbow Planet (GT×IT×SP×SA)

IT技術を分かりやすく簡潔にまとめることによる学習の効率化、また日常の気付きを記録に残すことを目指します。

01_IT技術 (Technology)

VBAによるマトリクスの行列を反転させて転記するプログラム

投稿日:2019年6月2日 更新日:

(0)目次&概説

(1) マクロ概要
(2) 使用方法
(3) アルゴリズム概要
(4) プログラム

(1) マクロ概要

マトリクス形式で表現されたデータの行と列を入れ替えるプログラムです。
(※Excelであれば、コピーして貼り付けする際に「形式を選択して貼り付け(S)」を選択して、その中で「行/列の入れ替え(T)」を選択すると同様の操作ができます。Excelで標準装備している操作ですが、今回はVBAの勉強も兼ねて自力でプログラムを作成してみました・・)。

目次にもどる

(2) 使用方法

使用に際しては以下の準備作業を行います。
①シート「2.OldMatrix」(*注1)に転記前のマトリクスを準備します(*注1:シート名は任意の名前を指定可能)

②シート「2.NewMatrix」(*注2)に転記後のマトリクスの中の値が空の雛形を準備します(*注2:シート名は任意の名前を指定可能)
※時間が取れる時に、転記後は雛形を用意せずとも、ラベル含めて反転&転記してくれるように改修いたします。

③シート「Controller」にて以下のようにマクロ動作のインプット情報を与える表を作成します。この際、マトリクスの開始行/終了行/開始列/終了列の情報は各自のマトリクスに応じて変更します。

開始行や終了行などは、縦ラベルと横ラベルの交点の値が開始・終了する行の事を指しており、以下のようなイメージとなります。

④シート「Controller」にて、VBAプログラム「TurnOverMatrixRowCol()」呼び出し用のボタンを設置します。

準備は以上で、後はボタンを押せば「2.OldMatrix」シートの情報を、行と列を逆にして「2.NewMatrix」シートに転記します。

目次にもどる

(3) アルゴリズム概要

前半部(転記元のマトリクスの情報を取得)の変数の定義は以下の通りです。

No 変数名 説明
1 SheetName String 転記元のマトリクスのあるシート名を保持する変数。
2 RowStart Integer 転記元のマトリクスの行開始位置を保持する変数。
3 RowEnd Integer 転記元のマトリクスの行終了位置を保持する変数。
4 ColStart Integer 転記元のマトリクスの列開始位置を保持する変数。
5 ColEnd Integer 転記元のマトリクスの列終了位置を保持する変数。
6 MatrixSize Integer マトリクスの要素数(行ラベル×列ラベル)を保持する変数。
7 RowBand Variant 行ラベルを保持する配列。
8 ColBand Variant 列ラベルを保持する配列。
9 Value Variant マトリクスの要素を保持する配列。

後半部(取得した情報を転記先のマトリクスに反映)の変数の定義は以下の通りです。

No 変数名 説明
1 SheetName2 String 転記先のマトリクスのあるシート名を保持する変数。
2 RowStart2 Integer 転記先のマトリクスの行開始位置を保持する変数。
3 RowEnd2 Integer 転記先のマトリクスの行終了位置を保持する変数。
4 ColStart2 Integer 転記先のマトリクスの列開始位置を保持する変数。
5 ColEnd2 Integer 転記先のマトリクスの列終了位置を保持する変数。

処理のフローは以下の通りです。

Lv. (処理概要)
転記元のマトリクスの情報(行ラベル、列ラベル、値)を取得する。
1 転記元で、行の最初~最後までループ (ループ変数=i)
 2  ∟転記元で、列の最初~最後までループ (ループ変数=j)
  3   ∟カウンター(Count)をインクリメント
  3   ∟座標(i, j)の位置の列ラベルを取得
  3   ∟座標(i, j)の位置の行ラベルを取得
  3   ∟座標(i, j)の値を取得
Lv. (処理概要)
取得した転記元マトリクス情報を、転記先のマトリクスの適切な位置に転記する。
1 転記先で、行の最初~最後までループ (ループ変数=k)
 2  ∟転記先で、列の最初~最後までループ (ループ変数=m)
  3   ∟転記先で、転記元の取得情報の最初~最後までループ (ループ変数=n)
   4    ∟転記先の各座標に対して転記元の全パターンと突合を行い一致を判定
    (※転記先と転記元で「行ラベル」&「列ラベル」が両方一致したら情報一致と判定)
   4    ∟情報一致したら、転記元の値を転記先のセルにコピー

目次にもどる

(4) プログラム

Sub TurnOverMatrixRowCol()

    'コピー元シートから情報取得
    Dim SheetName   As String:  SheetName = Worksheets("2.Controller").Cells(2, 3).Value  '転記元シート
    Dim RowStart    As Integer: RowStart = Worksheets("2.Controller").Cells(3, 3).Value
    Dim RowEnd      As Integer: RowEnd = Worksheets("2.Controller").Cells(4, 3).Value
    Dim ColStart    As Integer: ColStart = Worksheets("2.Controller").Cells(5, 3).Value
    Dim ColEnd      As Integer: ColEnd = Worksheets("2.Controller").Cells(6, 3).Value
    Dim MatrixSize  As Integer: MatrixSize = (RowEnd - RowStart + 1) * (ColEnd - ColStart + 1)
    Dim RowBand     As Variant: ReDim RowBand(MatrixSize)
    Dim ColBand     As Variant: ReDim ColBand(MatrixSize)
    Dim Value       As Variant: ReDim Value(MatrixSize)
    
    Worksheets("2.NewMatrix").Activate
    
    '行のループ
    For i = RowStart To RowEnd
        '列のループ
        For j = ColStart To ColEnd
            
            Count = Count + 1
            
            '列の帯にある値を取得
            ColBand(Count) = Worksheets(SheetName).Cells(RowStart - 1, j).Value
            
            '行の帯にある値を取得
            RowBand(Count) = Worksheets(SheetName).Cells(i, ColStart - 1).Value
            
            '行列の交点にある値を取得
            Value(Count) = Worksheets(SheetName).Cells(i, j)
        Next j
    Next i
    
    'コピー先のシートに転記
    Dim SheetName2  As String:  SheetName2 = Worksheets("2.Controller").Cells(2, 4).Value  '転記先シート
    Dim RowStart2   As Integer: RowStart2 = Worksheets("2.Controller").Cells(3, 4).Value
    Dim RowEnd2     As Integer: RowEnd2 = Worksheets("2.Controller").Cells(4, 4).Value
    Dim ColStart2   As Integer: ColStart2 = Worksheets("2.Controller").Cells(5, 4).Value
    Dim ColEnd2     As Integer: ColEnd2 = Worksheets("2.Controller").Cells(6, 4).Value
    
    '行のループ
    For k = RowStart2 To RowEnd2
        '列のループ
        For m = ColStart2 To ColEnd2
            
            '取得した全項目について、新マトリクスの行列のどこに当てはまるかをチェック
            For n = 1 To Count
                                    
                '項目に対して以下のチェックを行い、TRUEなら正しい転記先とみなす。
                ' ①転記先シートの「新」列帯(元行帯)と名前が一致するか?
                ' かつ(AND)
                ' ②転記先シートの「新」行帯(元列帯)と名前が一致するか?
                If Worksheets(SheetName2).Cells(RowStart2 - 1, m).Value = RowBand(n) _
                And Worksheets(SheetName2).Cells(k, ColStart2 - 1).Value = ColBand(n) Then

                    '一致した場合は値の正しい転記先であると判断して、転記を行う
                    Worksheets(SheetName2).Cells(k, m).Value = Value(n)
                
                End If
            Next n
        Next m
    Next k
    
End Sub

目次にもどる

Adsense審査用広告コード


Adsense審査用広告コード


-01_IT技術 (Technology)

執筆者:


comment

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

関連記事

Linuxサーバー(CentOS6)にTomcatをインストールする手順

(0)目次&概説 (1) Tomcatとは? (2) Tomcatインストールと疎通チェック  (2-1) Tomcat用ユーザーの作成  (2-2) Tomcatの資源をダウンロード  (2-3) …

OracleDB11g で新規表領域とスキーマの作成

(0) 目次 (1) 表領域の作成 (2) スキーマの作成 (3) スキーマの接続権限を付与 (4) 用語解説 (1) 表領域の作成 表領域とデータベースファイル(dbf)を以下のコマンドで作成します …

VBAによる郵便番号の正規表現マッチ確認関数&置換関数の作成

(0)目次&概説 (1) 正規表現とは (2) 正規表現はどのような場面で利用される? (3) VBAによる正規表現の簡易チェックツール  (3-1) 郵便番号を抽出したい  (3-2) 正規表現が正 …

Linux:定期的に再起動するスクリプト

Linuxサーバーを定期的に再起動するスクリプトを紹介します。定期的に再起動するという処理はシステム構築においては、運用の中で定義される「死活監視」に関連してくる話になります。 ●シェルとは?シェルス …

CiscoのIP電話を用いた複数拠点での電話会議の方法について

(0)目次 (1) Cisco製品を使った電話会議 (2) Conference方式 (3) Meet-Me方式 (1) Cisco製品を使った電話会議 仕事で遠隔地の拠点との会議をするケースがあると …

Top