【EXCEL VBA（マクロ）】行と列の入れ替えて貼り付ける

行と列の入れ替えて貼り付けする

Sub 行と列の入れ替え()
　Range("A2:A25").Copy
　Range("E1").PasteSpecial Transpose:=True
MsgBox "完了"
End Sub

行と列の入れ替えて新規シートに貼り付けする

このVBAコードは、基のシートのデータを、相手のシートに行列を転置するために使用されます。

＊F8でできる

Sub 行列変換()

Dim i As Long
Dim j As Long
Dim Z As Long
    
'基_アクティブシート
Dim wb1 As Workbook
    Set wb1 = ThisWorkbook
Dim ws1 As Worksheet
    Set ws1 = wb1.ActiveSheet
Dim LastRow1 As Long
    LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim LastCol1 As Long
    LastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

'相手_アクティブシートの右のシート
Dim wb2 As Workbook
    Set wb2 = ThisWorkbook
Dim ws2 As Worksheet
    Set ws2 = wb2.ActiveSheet.Next


    '横ループ
    For i = 1 To LastRow1

        Z = 1
        '縦ループ
        For j = 1 To LastCol1

            'データ転記
            ws2.Cells(Z, i) = ws1.Cells(i, j)
            Z = Z + 1

        Next j
        
    Next i
    
MsgBox "完了"
End Sub

解説

2行目から12行目：変数の宣言と初期化
14行目：基のアクティブシートを設定
15行目：基のアクティブシートの最終行を決定
16行目：基のアクティブシートの最終列を決定
18行目：相手のアクティブシートを設定
20行目：基のアクティブシートからデータを読み取り、相手のアクティブシートにコピーするためのループを始めます。
21行目：Zの初期値を設定します。
23行目：列をループします。
25行目：基のアクティブシートの(i, j)セルの値を、相手のアクティブシートの(Z, i)セルにコピーします。
26行目：Zを1増やします。
29行目：ループを終了します。
31行目：ループを終了します。
33行目：処理が完了したことを通知するメッセージボックスが表示されます。

改善点：

このVBAコードは、相手のアクティブシートの最終行と最終列を決定するために、不要な処理が行われています。これは、実行時間の増加を引き起こす可能性があります。この問題を解決するには、基のアクティブシートの最終行と最終列を事前に決定し、それらの値を使用することができます。
VBAコードが処理される際に、スクリーンの更新、イベントの通知、アラートの表示、計算モードの設定などのオプションが無効になっています。これにより、実行時間が短縮されます。
変数Zは、最初に0を代入することができます。これにより、Z = Z + 1とZ += 1と同じ結果が得られます。
ループのネストを反転させることができます。縦方向のループを外側のループとし、横方向のループを内側のループとすると、より効率的に処理できることがあります。ただし、この特定のVBAコードでは、パフォーマンスに大きな影響を与えないため、特に変更する必要はありません。

上記コードのスピードアップ改善コード

Sub 行列変換2()

Dim i As Long
Dim j As Long
Dim Z As Long

'基_アクティブシート
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
Dim ws1 As Worksheet
Set ws1 = wb1.ActiveSheet
Dim LastRow1 As Long
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim LastCol1 As Long
LastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

'相手_アクティブシートの右のシート
Dim wb2 As Workbook
Set wb2 = ThisWorkbook
Dim ws2 As Worksheet
Set ws2 = wb2.ActiveSheet.Next

'オプションの設定
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'横ループ
For i = 1 To LastRow1

    Z = 0
    '縦ループ
    For j = 1 To LastCol1

        'データ転記
        ws2.Cells(Z + 1, i) = ws1.Cells(i, j)
        Z = Z + 1

    Next j
    
Next i

'オプションの設定を元に戻す
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

MsgBox "完了"
End Sub

改善点は以下のとおりです。

基のアクティブシートの最終行と最終列を事前に決定し、それらの値を使用することにより、実行時間を短縮することができます。
Z変数を0で初期化することにより、Z = Z + 1とZ += 1と同じ結果が得られます。
スクリーンの更新、イベントの通知、アラートの表示、計算モードの設定などのオプションを無効にすることで、実行時間を短縮することができます。
最終行と最終列の取得において、ws1.Cells(Rows.Count, 1).End(xlUp).RowのようにCellsメソッドを使っているため、ws1.Rows.Countを使っても同じ結果を得ることができます。同様に、ws1.Columns.Countを使っても同じ結果を得ることができます。
データ転記のコードにおいて、ws2.Cells(Z + 1, i) = ws1.Cells(i, j)のようにZ変数を使用しているため、Z = Z + 1を使う必要があります。
最後に、オプションの設定を元に戻すことで、Excelの機能を

行と列の入れ替えて新規シート内に転記する

Sub 横リストを縦リストに変換_シート内()

Dim i As Long
Dim j As Long
Dim Z As Long
Dim RetuLoop As Long
Dim GyouLoop As Long

    '横ループ回数（列数を記入）
    RetuLoop = 5

    '縦ループ回数（行数を記入）
    GyouLoop = 6

    '縦ループ
    For i = 1 To GyouLoop

        Z = 1

        '横ループ
        For j = 1 To RetuLoop

            'データ転記
            Cells(Z, 6 + i) = Cells(i, j)
            Z = Z + 1

        Next j
    Next i
    
MsgBox "完了"
End Sub