| |
KEI さん、おはようございます。
>縦３列に並んだデータを、行列変換して、違うシートに一列に任意の空白を空けて、並べたいと考えています。
>ABC
>ABC ⇒ AAAA(任意の空白)BBBB（任意の空白)CCCC
>ABC
>ABC
>今まではシートの中にある一列のデータを全て選択して、行列変換して貼り付けていたので、以下のコードで問題ありませんでした。
ROW("A")もエラーになりそうなものですが。
列全体選択時の行数 ＞ シート上の列数
XP: 65536行 ＞ 256列
2007:1048576行 ＞ 16384列
なので列全体でコピーして回転すると範囲外にも貼り付けることになるので”コピー領域と貼り付け領域の形が違う”エラーになります
Sub test()
Dim ws(1 To 2) As Worksheet, r1 As Range
Dim CC As Long, Cpos As Long, Rpos As Long, NN As Long
'対象はこのブック
With ThisWorkbook
Set ws(1) = .Worksheets("Sheet1") 'コピー元
Set ws(2) = .Worksheets("Sheet2") 'コピー先
End With
'念のためクリア
ws(2).Cells.ClearContents
'貼り付け先情報
Rpos = 1 '貼り付け先行番号
Cpos = 1 '最初の貼り付け先列番号
NN = 2 '任意の空白
'開始
For CC = 1 To 3
'コピー元シートの処理
'データの入っている範囲をセット
With ws(1)
Set r1 = .Range(.Cells(1, CC), .Cells(.Rows.Count, CC).End(xlUp))
End With
'ペースト先シートの処理
With ws(2)
If Cpos + r1.Count > .Columns.Count Then
MsgBox vbCrLf & Cpos + r1.Count & " > " & ws(2).Columns.Count, _
vbExclamation, "Error" '列数オーバーで中断
Else
'コピペ
r1.Copy
.Cells(Rpos, Cpos).PasteSpecial Transpose:=True
Application.CutCopyMode = False
'次の貼り付け先
Cpos = Cpos + r1.Count + NN
End If
End With
Next
'終了
Set r1 = Nothing
Erase ws
End Sub
こんな感じです。
|
|
りん
- 08/5/13(火) 4:43 -
