PCWAY：ファイルデータを表示するときに、行と列を入れ替えて表示するには?

PCWAY：ファイルデータを表示するときに、行と列を入れ替えて表示するには?

現状では、ファイルデータを取りあえずシートに表示していただき、そのデータをもとに、マクロで行と列を入れ替えるしか 方法がありません。 マクロは、「ファイル処理登録」の通知イベント等で起動するように、「自動マクロ起動登録」で設定して下さい。

1.下記の青色の部分のマクロをご使用のブックのモジュールにコピーして下さい。
修正は必要ありません。

2.下記のマクロの使い方を示します。

使用例1:
Sheet1の B2:D5 の範囲を行と列を入れ替えてSheet2のB2を先頭に貼り付ける
Call Application.Run("RowColumn_Change","Sheet1","B2:D5","Sheet2","B2")

使用例2:
アクティブシートのB2:D5の範囲を行と列を入れ替えてアクティブシートのB7を先頭に貼り付ける
Call Application.Run("RowColumn_Change","","B2:D5","","B7")
入れ替え元の範囲内に、入れ替え先のセル位置が存在すると動作しないので、ご注意下さい。

事例）
ファイルデータが Sheet1のB2:D5の範囲に表示されている場合に、行と列を入れ替えてSheet2のB7に貼り付ける

1)下記の青色の部分のマクロをご使用のブックのモジュールにコピーします。

2)マクロを作成します。
Sub test() '異なるシート間のコピーの場合、Sheet2がアクティブになったときに、Sheet1の情報は'更新されませんから、下記の3行が必要です。'なお、この"PCWAYsubSheetRefreshNoMessage"のマクロはVer1.06以降しか使用出来ません。

If ActiveSheet.Name <> "Sheet1" Then
Call Application.Run("PCWAYsubSheetRefreshNoMessage", "Sheet1")
End If

Call Application.Run("PCWAYsubRowColumnChange", "Sheet1", "B2:D5", "Sheet2", "B7")
End Sub

3)[ファイル処理登録］の通知イベントの処理するのチェックボックスにチェックを付け、イベントV0を登録する。

4)[自動マクロ起動登録]の処理するのチェックボックスにチェックを付け、トリガV0、マクロ名testを登録する。

以上です。 　　 行 <=> 列　入れ替え処理 ' '


--------------------------------------------------------------------------------

引数1　strFromSheet : 入れ替え元シート名称 ""ならアクティブシート Ex) "Sheet1"
引数2　strFromRange : 入れ替え元範囲 Ex) "B2:D10"
引数3　strToSheet : 入れ替え先シート名称 ""ならアクティブシート Ex) "Sheet2"
引数4　strToCell : 入れ替え先先頭セル位置 Ex) "B2"

使用例1:Sheet1の B2:D5 の範囲を行と列を入れ替えて Sheet2の B2を先頭に貼り付ける

Call Application.Run("RowColumn_Change","Sheet1","B2:D5","Sheet2","B2")

使用例2:アクティブシートの B2:D5 の範囲を行と列を入れ替えて アクティブシートの B7を先頭に貼り付ける

Call Application.Run("RowColumn_Change", "", "B2:D5", "", "B7")

使用上の注意:入れ替え元の範囲内に,入れ替え先のセル位置が存在すると動作しない!


--------------------------------------------------------------------------------

Sub PCWAYsubRowColumnChange(strFromSheet As String, strFromRange As
String, strToSheet As String, strToCell As String)
Dim strSheetname As String
If strFromSheet = "" Then
strSheetname = ActiveSheet.Name
Else
strSheetname = strFromSheet
End If

Worksheets(strSheetname).Range(strFromRange).Copy
If strToSheet = "" Then
strSheetname = ActiveSheet.Name
Else
strSheetname = strToSheet
End If

Worksheets(strSheetname).Range(strToCell).PasteSpecial
Paste:=xlFormats, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Worksheets(strSheetname).Range(strToCell).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True
Application.CutCopyMode = False
End Sub