行と列を入れ替える

記事「数式を値に変換する 」では
[編集]メニューの[形式を選択して貼り付け]を使いました。

行と列を入れ替えるのにも[形式を選択して貼り付け]が使えそうです。

[編集]メニューの[形式を選択して貼り付け]を選択すると
下の画像のダイアログが表示されます。

[行列を入れ替える]にチェックを入れて、
OKボタンを押すと行と列が入れ替えられてペーストされます。

ペーストする際、
コピー元の範囲とペーストする範囲が
一部でも重なるとペーストできません。

ですのでVBAでこれを使ってシート内のすべてのセルの行と列を入れ替えるのに、
新しいシートを追加して
その新しいシートに行と列を入れ替えたものをペーストすることにします。
コピー元のシートは削除します。

コードはこちら

Sub macro100512a()
'アクティブシートの使用している範囲の
'行と列を入れ替える

    Dim shname As String
    shname = ActiveSheet.Name
   
    '使用範囲をコピー
    ActiveSheet.UsedRange.Select
    Selection.Copy
   
    '新しいシートを名前を付け追加し、行と列を入れ替えペースト
    Sheets.Add.Name = shname & "tmp"
    Range("A1").Select
    Selection.PasteSpecial Transpose:=True
   
    'コピー元シートを削除
    Application.DisplayAlerts = False
        Sheets(shname).Delete
    Application.DisplayAlerts = True
   
    'ペーストしたシートの名前をコピー元シートと同じ名前に変更
    Sheets(shname & "tmp").Name = shname
   
End Sub

次は、引数付きのプロシージャでやってみます。

コードはこちら

変数Range1にコピー元の範囲を
変数Range2にペースト先の左上のセルを指定します。

Sub ExchangeRC(Range1 As Range, Range2 As Range)
'指定した範囲の行列を入れ替える
'Range1 = コピー元の範囲
'Range2 = ペースト先の範囲の左上のセル
   
    'Range1で指定した範囲をコピー
    Range1.Copy
   
    'Range2で指定した範囲に行と列を入れ替えペースト
    Range2.Select
    On Error GoTo ErrHandle
    Selection.PasteSpecial Transpose:=True
    On Error GoTo 0
    Application.CutCopyMode = False
   
Exit Sub
ErrHandle:
    If Err = 1004 Then
        MsgBox "選択範囲が正しくありません。" & Chr(10) & _
            "コピー元の範囲とペースト先の範囲が重なっていないか" & _
            "確認してください｡"
    Else
        MsgBox "実行時エラー" & Err & ":" & Err.Description
    End If
   
End Sub

Sub macro100512c()
'ExchangeRC使用例1
'アクティブシート内でのコピペ

    Call ExchangeRC(Range("F14:G19"), Range("G19"))
   
End Sub

Sub macro100512d()
'ExchangeRC使用例2
'異なるシート間のコピペ

    Call ExchangeRC(Sheets("Sheet1").Range("F14:G19"), _
        Sheets("Sheet2").Range("G20"))
   
End Sub

コピー元とペースト先の範囲が重なっていた場合、
エラーになり
このようなMsgBoxを表示します。

このエラーが発生した時は
ペースト先の範囲をコピー元の範囲と重ならないように変更してください。