teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

コードの修正と追加

2018/04/03 15:13

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -4,25 +4,56 @@
4
4
 
5
5
 
6
6
  ```vba
7
- Public Sub 可変列へ転記()
7
+ Public Sub 可変列()
8
- Dim Rng1 As Range, rng2 As Range
8
+ Dim Rng1 As Range, Rng2 As Range
9
9
  Dim MaxRow As Long, MaxCol As Long
10
- Dim i As Long, j As Long
10
+ Dim i As Long
11
11
 
12
- If Worksheets("Sheet3").Range("A1").Value = "" Then
12
+ If Worksheets("Sheet1").Range("A1").Value = "" Then
13
13
  MsgBox "データがありません。"
14
14
  Exit Sub
15
15
  End If
16
16
 
17
- Set Rng1 = Worksheets("Sheet3").Range("A1", "B1") 'コピー元の最初のセル範囲
17
+ Set Rng1 = Worksheets("Sheet1").Range("A1", "B1") 'コピー元の最初のセル範囲
18
- Set rng2 = Worksheets("Sheet4").Range("A1", "B1") 'コピー先の最初のセル範囲
18
+ Set Rng2 = Worksheets("Sheet2").Range("A1", "B1") 'コピー先の最初のセル範囲
19
19
 
20
- MaxRow = Rng1.End(xlDown).Row
20
+ MaxRow = Rng1.End(xlDown).Row 'コピー元の行数
21
- MaxCol = rng2.End(xlToRight).Column
21
+ MaxCol = Rng2.End(xlToRight).Column 'コピー先の項目の列数
22
22
 
23
23
  For i = 1 To MaxRow
24
- rng2.Offset(1 + ((i - 1) \ (MaxCol \ 2)), ((i - 1) * 2) Mod MaxCol).Value _
24
+ Rng2.Offset(1 + ((i - 1) \ (MaxCol \ 2)), ((i - 1) * 2) Mod MaxCol).Value _
25
25
  = Rng1.Offset(i).Value
26
26
  Next
27
27
  End Sub
28
+ ```
29
+ ---
30
+ 配列を使用して高速化したバージョン
31
+ ```vba
32
+ Public Sub 可変列へ転記_配列()
33
+ Dim aryFrom(), aryTo()
34
+ Dim MaxRow As Long, MaxCol As Long
35
+ Dim i As Long, r As Long, c As Long
36
+
37
+ If Worksheets("Sheet1").Range("A1").Value = "" Then
38
+ MsgBox "データがありません。"
39
+ Exit Sub
40
+ End If
41
+
42
+ MaxRow = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
43
+ MaxCol = Worksheets("Sheet2").Range("A1").CurrentRegion.Columns.Count
44
+
45
+ aryFrom = Worksheets("Sheet1").Range("A2", "B" & MaxRow).Value 'コピー元のデータを配列に格納
46
+ ReDim aryTo(1 To MaxRow \ (MaxCol \ 2) + 1, 1 To MaxCol) '出力先配列のサイズを確保
47
+
48
+
49
+ For i = 1 To MaxRow - 1
50
+ r = 1 + ((i - 1) \ (MaxCol \ 2))
51
+ c = ((i - 1) * 2) Mod MaxCol + 1
52
+ aryTo(r, c) = aryFrom(i, 1)
53
+ aryTo(r, c + 1) = aryFrom(i, 2)
54
+ Next
55
+
56
+ Worksheets("Sheet2").Range("A2").Resize(UBound(aryTo), MaxCol).Value = aryTo
57
+ End Sub
58
+
28
59
  ```