質問編集履歴

1

記入していなかったコードの記入。それに伴う説明文書の小変更

2021/12/15 04:44

投稿

ukuu
ukuu

スコア1

test CHANGED
@@ -1 +1 @@
1
- VBAを用いて48個のデータを6個ずつに分けて入力する方法
1
+ VBAを用いて.txt内の48個のデータを6個ずつに分けて入力する方法
test CHANGED
@@ -2,13 +2,17 @@
2
2
 
3
3
  VBAを使用し、下記のような入力がしたいです
4
4
 
5
+ ①.txtファイルを選択し、指定の48個のデータを抽出
6
+
7
+ ↑ここまではできています
8
+
5
- 48個のデータ内の最初の6個を、作業者が選択したセルから縦に入力
9
+ 48個のデータ内の最初の6個を、作業者が選択したセルから縦に入力
6
-
10
+
7
- 縦に4つ飛ばし、次の6個を縦に入力
11
+ 縦に4つ飛ばし、次の6個を縦に入力
8
-
12
+
9
- 最初に選択したセルから右に4行飛ばし、次の6個を入力 
13
+ 最初に選択したセルから右に4行飛ばし、次の6個を入力 
10
-
14
+
11
- また縦に4つ飛ばし、次の6個を入力
15
+ また縦に4つ飛ばし、次の6個を入力
12
16
 
13
17
   このループを4回分
14
18
 
@@ -30,13 +34,197 @@
30
34
 
31
35
  ### 該当のソースコード
32
36
 
33
-
37
+ Sub 入力()
38
+
39
+ Dim NUMB As Variant
40
+
41
+ Dim 配列(9999) As Double
42
+
43
+ Dim i As Integer
44
+
45
+ Dim POG As Variant
46
+
47
+ Dim k As Integer
48
+
49
+ Dim strFileName As String
50
+
51
+ Dim strFilePath As String
52
+
53
+ Dim a As Long
54
+
55
+
56
+
57
+ strFilePath = "ファイルの場所"
58
+
59
+ strFileName = X(strFilePath)
60
+
61
+
62
+
63
+ Workbooks.OpenText Filename:= _
64
+
65
+ strFilePath & strFileName, Origin:=932, _
66
+
67
+ StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
68
+
69
+ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
70
+
71
+ , Space:=False, Other:=False, fieldinfo:=Array(Array(1, 1), Array(2, 1), _
72
+
73
+ Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
74
+
75
+ Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
76
+
77
+ 16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
78
+
79
+ Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _
80
+
81
+ 29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _
82
+
83
+ Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1)), _
84
+
85
+ TrailingMinusNumbers:=True
86
+
87
+
88
+
89
+ Dim j As Long, l As Long
90
+
91
+ l = 1
92
+
93
+ For j = 2 To 1000
94
+
95
+ l = l + 1
96
+
97
+ If InStr(Cells(j, 4), "指定の文字列") = 0 Then
98
+
99
+ Exit For
100
+
101
+
102
+
103
+ End If
104
+
105
+ Next
106
+
107
+
108
+
109
+
110
+
111
+ For i = 1 To l
112
+
113
+ 入力(i) = Range("J" & i + 1).Value
114
+
115
+ Next
116
+
117
+
118
+
119
+ Workbooks(1).Worksheets("Sheet1").Activate
120
+
121
+
122
+
123
+ Set POG = Application.InputBox(prompt:="入力開始するセルをクリック", _
124
+
125
+ Default:=ActiveCell.Address, Type:=8)
126
+
127
+
128
+
129
+ l = l - 2
130
+
131
+ a = l / 8
132
+
133
+
134
+
135
+ For i = 1 To a
136
+
137
+ k = i - 1
138
+
139
+ POG.Offset(k, 0).Value = Round(入力(i))
140
+
141
+ Next
142
+
143
+
144
+
145
+ For i = a + 1 To a * 2
146
+
147
+ k = i - 7
148
+
149
+ POG.Offset(10 + k, 0).Value = Round(入力(i))
150
+
151
+ Next
152
+
153
+
154
+
155
+ For i = (a * 2) + 1 To a * 3
156
+
157
+ k = i - 13
158
+
159
+ POG.Offset(k, 4).Value = Round(入力(i))
160
+
161
+ Next
162
+
163
+
164
+
165
+ For i = (a * 3) + 1 To a * 4
166
+
167
+ k = i - 19
168
+
169
+ POG.Offset(10 + k, 4).Value = Round(入力(i))
170
+
171
+ Next
172
+
173
+
174
+
175
+ For i = (a * 4) + 1 To a * 5
176
+
177
+ k = i - 25
178
+
179
+ POG.Offset(k, 8).Value = Round(入力(i))
180
+
181
+ Next
182
+
183
+
184
+
185
+ For i = (a * 5) + 1 To a * 6
186
+
187
+ k = i - 31
188
+
189
+ POG.Offset(10 + k, 8).Value = Round(入力(i))
190
+
191
+ Next
192
+
193
+
194
+
195
+ For i = (a * 6) + 1 To a * 7
196
+
197
+ k = i - 37
198
+
199
+ POG.Offset(k, 12).Value = Round(入力(i))
200
+
201
+ Next
202
+
203
+
204
+
205
+ For i = (a * 7) + 1 To a * 8
206
+
207
+ k = i - 43
208
+
209
+ POG.Offset(10 + k, 12).Value = Round(入力(i))
210
+
211
+ Next
212
+
213
+
214
+
215
+ Workbooks(strFileName).Close True
216
+
217
+
218
+
219
+ Exit Sub
220
+
221
+
34
222
 
35
223
  ### 試したこと
36
224
 
37
- For文 If文を使って力技でやろうとしたのですが、あまりにもコードが汚くなってしまったので、諦めました
225
+ あまりにもコードが冗長になってしまったので
38
-
226
+
39
- きれいで分かりやすいコードを教えていただけるとありがたいです
227
+ きれいで分かりやすい書き方を教えていただけるとありがたいです
40
228
 
41
229
 
42
230