質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

3回答

887閲覧

VBA 縦2列を横3列(それ以上に変更可)に変換したい

Eston

総合スコア67

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2018/04/03 09:03

編集2018/04/03 09:21

シート1
名前     役職
武田信玄   社長
織田信長   副社長
上杉謙信   専務
前田利家   営業
etc..

これを

シート2
名前   役職   名前   役職   名前   役職
武田信玄 社長   織田信長 副社長  上杉謙信 専務
前田利家 営業   etc..

という風に、シート1をシート2に代入するときに、横に記入されるようにしたいのですが、Copyメソッドを利用するとそのままコピーされてしまい、
シート2のようにならないづに困っています。*名前と役職については、すでに書かれています

どなたか詳しい方がいましたら、ご教授ください。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2018/04/03 09:19 編集

横3列というのは可変ではなく固定条件ですか? VBAでセルを個別に参照して座標を指定して転写すればできそうですね。
Eston

2018/04/03 09:20

連絡ありがとうございます。可変条件です。
ExcelVBAer

2018/04/04 00:24

可変条件なら、その条件を示さない限り、誰も助言はくれませんよ?
guest

回答3

0

コピー元をループしながら、コピー先に代入
サピー先の座標は、列数から計算できます。
コードをシンプルにするために、Offset を使いました。

vba

1Public Sub 可変列() 2 Dim Rng1 As Range, Rng2 As Range 3 Dim MaxRow As Long, MaxCol As Long 4 Dim i As Long 5 6 If Worksheets("Sheet1").Range("A1").Value = "" Then 7 MsgBox "データがありません。" 8 Exit Sub 9 End If 10 11 Set Rng1 = Worksheets("Sheet1").Range("A1", "B1") 'コピー元の最初のセル範囲 12 Set Rng2 = Worksheets("Sheet2").Range("A1", "B1") 'コピー先の最初のセル範囲 13 14 MaxRow = Rng1.End(xlDown).Row 'コピー元の行数 15 MaxCol = Rng2.End(xlToRight).Column 'コピー先の項目の列数 16 17 For i = 1 To MaxRow 18 Rng2.Offset(1 + ((i - 1) \ (MaxCol \ 2)), ((i - 1) * 2) Mod MaxCol).Value _ 19 = Rng1.Offset(i).Value 20 Next 21End Sub

配列を使用して高速化したバージョン

vba

1Public Sub 可変列へ転記_配列() 2 Dim aryFrom(), aryTo() 3 Dim MaxRow As Long, MaxCol As Long 4 Dim i As Long, r As Long, c As Long 5 6 If Worksheets("Sheet1").Range("A1").Value = "" Then 7 MsgBox "データがありません。" 8 Exit Sub 9 End If 10 11 MaxRow = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count 12 MaxCol = Worksheets("Sheet2").Range("A1").CurrentRegion.Columns.Count 13 14 aryFrom = Worksheets("Sheet1").Range("A2", "B" & MaxRow).Value 'コピー元のデータを配列に格納 15 ReDim aryTo(1 To MaxRow \ (MaxCol \ 2) + 1, 1 To MaxCol) '出力先配列のサイズを確保 16 17 18 For i = 1 To MaxRow - 1 19 r = 1 + ((i - 1) \ (MaxCol \ 2)) 20 c = ((i - 1) * 2) Mod MaxCol + 1 21 aryTo(r, c) = aryFrom(i, 1) 22 aryTo(r, c + 1) = aryFrom(i, 2) 23 Next 24 25 Worksheets("Sheet2").Range("A2").Resize(UBound(aryTo), MaxCol).Value = aryTo 26End Sub 27

投稿2018/04/03 13:34

編集2018/04/03 15:13
hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Eston

2018/05/10 09:37

返信遅れて、申し訳ありません。高速化バージョンまでありがとうございます。
guest

0

ベストアンサー

やりかたはいろいろありますが、Rangeオブジェクトに何回もアクセスすると処理が遅くなるので、もし対象データを処理したい場合にはデータをバリアント型変数(配列)に読み込み、処理が完了したらシートに書き戻すようにすると処理が速くなります。

ということで、ご参考まで。

サンプルデータでは(名前×役職)の1組が縦に並んでいたものを、1行に(名前×役職)を3組ずつ並べていますが、下記の実装例では「シート2」の見出し行から、1行に何組ずつ並べれば良いかを自動的に計算しています。
(なので、ちょっとごちゃごちゃしていますが、データ量が多い場合でもかなり高速に処理できるはずです。)

VBA

1Sub narabekae() 2 Dim lngRow1 As Long, lngRow2 As Long, lngCol2 As Long 3 Dim rngData As Range 4 Dim vntSrc As Variant, vntDst As Variant 5 Dim I As Long, J As Long, K As Long 6 7 '-- コピー元データを配列に取り込み 8 With ThisWorkbook 9 With .Worksheets("シート1") 10 '-- 最終行を取得 11 lngRow1 = .Cells(Rows.Count, 1).End(xlUp).Row 12 13 Set rngData = .Range(.Cells(2, 1), .Cells(lngRow1, 2)) 14 vntSrc = rngData.Value2 15 Set rngData = Nothing 16 End With 17 End With 18 19 '-- コピー先シートへデータを貼り付け 20 With ThisWorkbook 21 With .Worksheets("シート2") 22 '-- 最終列を取得 23 lngCol2 = .Cells(1, Columns.Count).End(xlToLeft).Column 24 25 '-- 最終行を計算 26 lngRow2 = Application.WorksheetFunction.RoundUp(2 * lngRow1 / lngCol2, 0) + 1 27 28 '-- コピー先の配列を用意 29 Set rngData = .Range(.Cells(2, 1), .Cells(lngRow2, lngCol2)) 30 vntDst = rngData.Value2 31 32 For I = 1 To lngRow1 - 1 33 J = Application.WorksheetFunction.RoundUp(2 * I / lngCol2, 0) 34 K = 2 * ((I - 1) Mod (lngCol2 / 2)) + 1 35 vntDst(J, K) = vntSrc(I, 1) 36 vntDst(J, K + 1) = vntSrc(I, 2) 37 Next I 38 39 '-- コピー済みデータを書き戻し 40 rngData.Value = vntDst 41 Set rngData = Nothing 42 End With 43 End With 44 45End Sub

バリアント型変数 = Range型変数.Value で対象のセル範囲を一括で配列変数へ取り込めます。(ちなみに、セル内の値のみを取り込めば良い場合は Value2 にすると、気持ちだけリソースの節約になります。)

処理結果を書き戻す場合は Range型変数.Value = バリアント型変数 で一括で書き戻しできます。

以上、ご参考になれば幸いです。

投稿2018/04/04 16:15

pi-chan

総合スコア5936

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Eston

2018/05/10 09:38

コメントがわかりやすくて助かります。ありがとうございます。
guest

0

追記1804032249:質問を見間違えていました。以下のコードは参考にしないでください。


Range.PasteSpecialでも出来るはずですが、あえて使わない方法を。

ワークシート関数のTRANSPOSEを使用すると、セルの縦横を逆にした配列を取得できます。

それを上手く使うと以下のように書けます。

VBA

1'コピー元の範囲を取得 2Dim srcWs As Excel.Worksheet 3Set srcWs = ThisWorkbook.Worksheets.Item("Sheet1") 4 5Dim srcRng As Excel.Range 6Set srcRng = srcWs.Range("A2:B4") '仮に範囲を決め打ちしています。 7 8'コピー先の左上の角のセルを取得 9Dim destWs As Excel.Worksheet 10Set destWs = ThisWorkbook.Worksheets.Item("Sheet2") 11 12Dim destRootRng As Excel.Range 13Set destRootRng = destWs.Range("A2") 14 15'値を貼り付ける範囲 16Dim destRng As Excel.Range 17Set destRng = destRootRng.Resize(srcRng.Columns.Count, srcRng.Rows.Count) 18 19'値貼り付け 20destRng.Value() = Excel.WorksheetFunction.Transpose(srcRng.Value())

投稿2018/04/03 13:46

編集2018/04/03 13:48
imihito

総合スコア2166

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問