回答編集履歴

2

追記

2021/07/13 00:05

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -109,3 +109,25 @@
109
109
  End Sub
110
110
 
111
111
  ```
112
+
113
+ ---
114
+
115
+ <追記>
116
+
117
+ あなたにとって i とは何なのか、見失ってはいませんか。
118
+
119
+
120
+
121
+ ```VBA
122
+
123
+ For i = 1 To colect.Count
124
+
125
+ sheet2.Cells(i + 1, 1).Resize(, 4).Value = colect.item(i)
126
+
127
+ Next
128
+
129
+ ```
130
+
131
+ これが正しいかどうかは、私にもわかりません。
132
+
133
+ あなた自身で確かめてみてください。

1

修正

2021/07/13 00:05

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -2,109 +2,109 @@
2
2
 
3
3
  ```VBA
4
4
 
5
- Const ST_ROW As Long=4
5
+ Const ST_ROW As Long = 4
6
6
 
7
- Const ST_COL As Long=2
7
+ Const ST_COL As Long = 2
8
8
 
9
9
 
10
10
 
11
11
  Sub 数と日付()
12
12
 
13
- Dim Wb1 As Workbook
13
+ Dim Wb1 As Workbook
14
14
 
15
- Dim Wb2 As Workbook
15
+ Dim Wb2 As Workbook
16
16
 
17
- Dim ary() As String
17
+ Dim ary() As String
18
18
 
19
- Dim row As Long
19
+ Dim row As Long
20
20
 
21
- Dim col As Long
21
+ Dim col As Long
22
22
 
23
- Dim sheet1 As Worksheet
23
+ Dim sheet1 As Worksheet
24
24
 
25
- Dim sheet2 As Worksheet
25
+ Dim sheet2 As Worksheet
26
26
 
27
- Dim lastRow As Long
27
+ Dim lastRow As Long
28
28
 
29
- Dim lastcol As Long
29
+ Dim lastcol As Long
30
30
 
31
- Dim index As Long
31
+ Dim index As Long
32
32
 
33
- Dim index2 As Long
33
+ Dim index2 As Long
34
34
 
35
- Dim colect As Collection, item As Variant
35
+ Dim colect As Collection, item As Variant
36
36
 
37
- Set colect=New Collection
37
+ Set colect = New Collection
38
38
 
39
- sPath="Book11.xlsx"
39
+ sPath = "Book11.xlsx"
40
40
 
41
- Set Wb1=ThisWorkbook 'コピー先ブック
41
+ Set Wb1 = ThisWorkbook 'コピー先ブック
42
42
 
43
+
43
44
 
45
+ Set Wb2 = Workbooks("Book11.xlsx") 'コピー元(参照する)ブック
44
46
 
45
- Set Wb2 = Workbooks("Book11.xlsx") 'コピー元(参照する)ブック
47
+ Set sheet1 = Wb2.Worksheets("コピー元")
46
48
 
47
- Setsheet1=Wb2.Worksheets("コピー")
49
+ Set sheet2 = Wb1.Worksheets("コピー")
48
50
 
49
- Set sheet2=Wb1.Worksheets("コピー先")
51
+ lastRow = sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row
50
52
 
51
- lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row
53
+ lastcol = sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column
52
54
 
53
- lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column
55
+ ReDim ary(0, lastcol - ST_COL)
54
56
 
55
- ReDim ary(0, lastcol - ST_COL)
57
+ For row = ST_ROW To lastRow
56
58
 
57
- For row=ST_ROW To lastRow
59
+ If sheet1.Cells(row, 4) >= 2 Then
58
60
 
59
- If sheet1.Cells(row, 4) >= 2 Then
61
+ For col = ST_COL To lastcol
60
62
 
61
- For col=ST_COL To lastcol
63
+ ary(index, index2) = sheet1.Cells(row, col)
62
64
 
63
- ary(index, index2) = sheet1.Cells(row, col)
65
+ index2 = index2 + 1
64
66
 
65
- index2=index2+1
67
+ Next
66
68
 
67
- Next
69
+ colect.Add ary
68
70
 
69
- colect.Add ary
71
+ End If
70
72
 
71
- End If
73
+ index2 = 0
72
74
 
73
- index2 = 0
75
+ Next
74
76
 
75
- Next
77
+ Dim row2 As Long
76
78
 
77
- Dim row2 As Long
79
+ Dim col2 As Long
78
80
 
79
- Dim col2 As Long
81
+ Dim i As Long
80
82
 
81
- Dim i As Long
83
+
82
84
 
85
+ ここから下が不明点
83
86
 
87
+ For row2 = 2 To colect.Count
84
88
 
85
- ここから下が不明点
89
+ For col2 = 1 To 4
86
90
 
87
- For row2=2 To colect.Count
91
+ sheet2.Cells(row2, col2) = colect.item(i)
88
92
 
89
- For col2=1 To 4
93
+ col2 = col2 + 1
90
94
 
91
- sheet2.Cells(row2, col2)=colect.item(i)
95
+ Next
92
96
 
93
- col2=col2+1
97
+ col2 = 0
94
98
 
95
- Next
99
+ Next
96
100
 
97
- col2=0
101
+ sheet2.Range("A1:D1").Value = sheet1.Range("B3:E3").Value
98
102
 
99
- Next
103
+ With ActiveSheet
100
104
 
101
- sheet2.Range("A1:D1").Value=sheet1.Range("B3:E3").Value
105
+ .Range("A1").Sort key1:=.Range("D1"), order1:=xlAscending, Header:=xlYes
102
106
 
103
- With ActiveSheet
104
-
105
- .Range("A1").Sort key1:=.Range("D1"), order1:=xlAscending, Header:=xlYes
106
-
107
- End With
107
+ End With
108
108
 
109
109
  End Sub
110
110