teratail
回答率
85.48%
質問するログイン新規登録
トップに関する質問VBAでtxtを検索

編集履歴

質問編集履歴

5

質問内容を変更しました

2019/03/04 02:46

投稿

yuurin
yuurin

スコア13

test CHANGED
File without changes
test CHANGED
@@ -12,6 +12,14 @@
12
12
 
13
13
  どのようにすればいいか、どこを改修すればいいのかヒントでもいいので教えていただきたいです
14
14
 
15
+
16
+
17
+ また、こうした処理をする場合、テキストボックスを使用するのとセルに入力してもらうのとどちらの形の方が作りやすいですか?
18
+
19
+
20
+
21
+
22
+
15
23
  ```VBA
16
24
 
17
25
  '標準モジュール

4

searchNameの部分を書き換えました

2019/03/04 02:46

投稿

yuurin
yuurin

スコア13

test CHANGED
File without changes
test CHANGED
@@ -2,15 +2,15 @@
2
2
 
3
3
  プログラミングの経験がなく、VBA自体を初めて触るものです
4
4
 
5
- VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業をしたいのですが、やりたい事としては
6
-
7
- (1)excelワークシートに入力する場所を３０枠用意し、間に空白のセルがあってもちゃんと検索し、出力できるようにする
5
+ VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業ですが、excelワークシートに入力する場所を３０枠用意し、間に空白のセルがあってもちゃんと検索し、出力できるようにしたいです
8
-
6
+
7
+
8
+
9
- (2)同一の名字が複数人いる場合、該当者がいない場合、全角文字がつかわれている場合、苗字ではなく名前のみで検索されている場合というそれぞれの場合でエラーメッセージを出す（エラーが起こったら、処理をそこで停止する）
9
+ わからないなりに書き換えてみましたが、Public Sub executeSeachAndOutput(ByVal inputDataList As Variant)
10
+
10
-
11
+ の部分で処理が止まってしまいます
12
+
11
- という二つが出来る様に改修をしたいのですが、どの部分を改修すればよいかアドバイスをお願いします
13
+ どのようにすればいいか、どこを改修すればいいのかヒントでもいいので教えていただきたいです
12
-
13
-
14
14
 
15
15
  ```VBA
16
16
 
@@ -414,37 +414,37 @@
414
414
 
415
415
 
416
416
 
417
- Public Function executeSeach(ByVal inputDataList As Collection, ByVal nameList As Collection) As Collection
417
+ Public Function executeSeach(ByVal inputDataList As Variant, ByVal nameList As Variant) As Variant
418
-
419
- '読み込んだデータリストから部分一致で名前を検索し、
418
+
420
-
421
- '一致したデータ行をリストに格納
419
+
422
-
423
- '名前から部分一致するリストをリストとして格納
420
+
424
-
425
- Dim hitDataList As Collection
421
+ Dim hitDataList(29) As Variant
426
-
427
- Set hitDataList = New Collection
422
+
428
-
423
+
424
+
429
- Dim inputItemList As Collection
425
+ Dim inputItemList(29) As Variant
430
-
431
- Set inputItemList = New Collection
426
+
432
-
427
+
428
+
433
- Dim inputNameData As String
429
+ Dim inputNameData(29) As Variant
434
-
430
+
435
- Dim nameItem As Variant
431
+ Dim nameItem(29) As Variant
436
-
432
+
437
- Dim nameData As String
433
+ Dim nameData(29) As Variant
438
-
439
- 'リストのリスト想定
434
+
440
-
435
+
436
+
437
+
438
+
441
- For Each inputItemList In inputDataList
439
+ For Each inputItemList In Range("B12:B41")
442
-
440
+
443
- nameData = inputItemList.Item(1) '名前が1つ目にくる想定
441
+ nameData = inputItemList.Item
444
-
445
- '部分一致させて、該当するならリストまるごと取得
442
+
446
-
443
+
444
+
445
+
446
+
447
- For Each nameItem In nameList
447
+ For Each nameItem In nameList
448
448
 
449
449
  If InStr(nameData, nameItem) <> 0 Then
450
450
 
@@ -454,13 +454,11 @@
454
454
 
455
455
  Next nameItem
456
456
 
457
- Next inputItemList
457
+
458
-
459
- '結果を返却
458
+
460
-
461
- Set executeSeach = hitDataList
462
-
463
- End Function
459
+ End Function
460
+
461
+
464
462
 
465
463
  ```
466
464
 

3

質問内容を変更しました

2019/03/04 02:16

投稿

yuurin
yuurin

スコア13

test CHANGED
File without changes
test CHANGED
@@ -1,6 +1,6 @@
1
1
  質問失礼いたします
2
2
 
3
-
3
+ プログラミングの経験がなく、VBA自体を初めて触るものです
4
4
 
5
5
  VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業をしたいのですが、やりたい事としては
6
6
 

2

質問内容を変更しました

2019/02/25 02:54

投稿

yuurin
yuurin

スコア13

test CHANGED
File without changes
test CHANGED
@@ -4,7 +4,7 @@
4
4
 
5
5
  VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業をしたいのですが、やりたい事としては
6
6
 
7
- (1)入力枠を３０枠用意し、間に空白の枠があってもちゃんと出力できるようにする
7
+ (1)excelワークシートに入力する場所を３０枠用意し、間に空白のセルがあってもちゃんと検索し、出力できるようにする
8
8
 
9
9
  (2)同一の名字が複数人いる場合、該当者がいない場合、全角文字がつかわれている場合、苗字ではなく名前のみで検索されている場合というそれぞれの場合でエラーメッセージを出す（エラーが起こったら、処理をそこで停止する）
10
10
 

1

ファイルの読み込みをしていたモジュールの追加をしました

2019/02/25 02:23

投稿

yuurin
yuurin

スコア13

test CHANGED
File without changes
test CHANGED
@@ -6,14 +6,414 @@
6
6
 
7
7
  (1)入力枠を３０枠用意し、間に空白の枠があってもちゃんと出力できるようにする
8
8
 
9
- (2)同一の名字・該当者がいない・全角文字がつかわれている・苗字ではなく名前のみで検索されているというそれぞれの場合でエラーメッセージを出す（エラーが起こったら、処理をそこで停止する）
9
+ (2)同一の名字が複数人いる場合、該当者がいない場合、全角文字がつかわれている場合、苗字ではなく名前のみで検索されている場合というそれぞれの場合でエラーメッセージを出す（エラーが起こったら、処理をそこで停止する）
10
-
10
+
11
- という二つが出来る様に改修をしたいのですが、どのようにすればいいでしょうか?
11
+ という二つが出来る様に改修をしたいのですが、どの部分を改修すればよいかアドバイスをお願いします
12
-
13
- これがその処理をしていると思われるクラスモジュールです
12
+
13
+
14
14
 
15
15
  ```VBA
16
16
 
17
+ '標準モジュール
18
+
19
+
20
+
21
+ 'ファイル取得処理
22
+
23
+ Public Sub GET_TextFile()
24
+
25
+ Dim objFS As Object
26
+
27
+ Dim strPath As String
28
+
29
+ Dim strFile As String
30
+
31
+ Dim strFolder As String
32
+
33
+ Dim ofdFolderDlg As Office.FileDialog
34
+
35
+
36
+
37
+ strPath = Range("selectFileName").Value
38
+
39
+ Set objFS = CreateObject("Scripting.FileSystemObject")
40
+
41
+
42
+
43
+ ' 初期パスの設定
44
+
45
+ If Len(strPath) > 0 Then
46
+
47
+ ' 末尾の"\"削除
48
+
49
+ If Right(strPath, 1) = "\" Then
50
+
51
+ strPath = Left(strPath, Len(strPath) - 1)
52
+
53
+ End If
54
+
55
+
56
+
57
+ ' ファイルが存在
58
+
59
+ If objFS.FileExists(strPath) Then
60
+
61
+ ' ファイル名のみ取得
62
+
63
+ strFile = objFS.GetFileName(strPath)
64
+
65
+ ' フォルダパスのみ取得
66
+
67
+ strFolder = objFS.GetParentFolderName(strPath)
68
+
69
+ ' ファイルが存在しない
70
+
71
+ Else
72
+
73
+ ' フォルダが存在
74
+
75
+ If objFS.FolderExists(strPath) Then
76
+
77
+ strFile = ""
78
+
79
+ strFolder = strPath
80
+
81
+ ' フォルダが存在しない
82
+
83
+ Else
84
+
85
+ ' ファイル名のみ取得
86
+
87
+ strFile = objFS.GetFileName(strPath)
88
+
89
+ ' 親フォルダを取得
90
+
91
+ strFolder = objFS.GetParentFolderName(strPath)
92
+
93
+ ' 親フォルダが存在しない
94
+
95
+ If Not objFS.FolderExists(strFolder) Then
96
+
97
+ strFolder = ThisWorkbook.Path
98
+
99
+ End If
100
+
101
+ End If
102
+
103
+ End If
104
+
105
+ Set objFS = Nothing
106
+
107
+ Else
108
+
109
+ strFolder = ThisWorkbook.Path
110
+
111
+ strFile = ""
112
+
113
+ End If
114
+
115
+
116
+
117
+ ' ファイル選択ダイアログ設定
118
+
119
+ Set ofdFileDlg = Application.FileDialog(msoFileDialogFilePicker)
120
+
121
+ With ofdFileDlg
122
+
123
+ .ButtonName = "選択"
124
+
125
+ '「ファイルの種類」をクリア
126
+
127
+ .Filters.Clear
128
+
129
+ '「ファイルの種類」を登録
130
+
131
+ .Filters.Add "テキストファイル", "*.txt", 1
132
+
133
+ .Filters.Add "全ファイル", "*.*", 2
134
+
135
+
136
+
137
+ ' 初期フォルダ
138
+
139
+ .InitialFileName = strFolder & "\" & strFile
140
+
141
+ ' 複数選択不可
142
+
143
+ .AllowMultiSelect = False
144
+
145
+ '表示するアイコンの大きさを指定
146
+
147
+ .InitialView = msoFileDialogViewDetails
148
+
149
+ End With
150
+
151
+
152
+
153
+
154
+
155
+
156
+
157
+ ' フォルダ選択ダイアログ表示
158
+
159
+ If ofdFileDlg.Show() = -1 Then
160
+
161
+ ' フォルダパス設定
162
+
163
+ strPath = ofdFileDlg.SelectedItems(1)
164
+
165
+ Else
166
+
167
+ ' キャンセルされた場合以降の処理は行なわない
168
+
169
+ Exit Sub
170
+
171
+ End If
172
+
173
+
174
+
175
+ Range("selectFileName").Value = strPath
176
+
177
+ Dim all As New Collection
178
+
179
+ Set all = New Collection
180
+
181
+ Set all = READ_TextFile(strPath)
182
+
183
+
184
+
185
+ '検索出力実行
186
+
187
+ Dim main As New suzukiMain
188
+
189
+ Call main.executeSeachAndOutput(all)
190
+
191
+ Set ofdFileDlg = Nothing
192
+
193
+
194
+
195
+ MsgBox "CSVファイルを" & Chr(13) & strPath & Chr(13) & "に出力完了しました。"
196
+
197
+
198
+
199
+ End Sub
200
+
201
+ ' ファイルの読み込み処理
202
+
203
+ '配列に格納する処理
204
+
205
+ Private Function READ_TextFile(ByVal strPathName As String) As Collection
206
+
207
+ Dim intNo As Integer
208
+
209
+ Dim objFS As Object
210
+
211
+ Dim strBuff As String
212
+
213
+ strPath = strPathName
214
+
215
+
216
+
217
+ Set objFS = CreateObject("Scripting.FileSystemObject")
218
+
219
+
220
+
221
+ If objFS.FileExists(strPath) = False Then
222
+
223
+ Exit Function
224
+
225
+ End If
226
+
227
+
228
+
229
+ ' ファイルオープン
230
+
231
+ intNo = FreeFile() ' フリーファイルNoを取得
232
+
233
+ Open strPathName For Input As #intNo ' ファイルをオープン
234
+
235
+
236
+
237
+ ' ファイルの読み込み
238
+
239
+ Dim arrayList As New Collection
240
+
241
+ Set arrayList = New Collection
242
+
243
+ Dim readList As New Collection
244
+
245
+ Set readList = New Collection
246
+
247
+
248
+
249
+ Do Until EOF(intNo) ' ファイルの最後までループ
250
+
251
+
252
+
253
+ Line Input #intNo, strBuff ' ファイルから一行読み込み
254
+
255
+
256
+
257
+
258
+
259
+ If Left(strBuff, 1) <> 2 Then '区分コードが2以外の場合次の行へ
260
+
261
+ GoTo nextLine
262
+
263
+ End If
264
+
265
+
266
+
267
+ readList.Add Trim(Mid(strBuff, 51, 30)) '氏名
268
+
269
+ readList.Add Trim(Mid(strBuff, 6, 15)) '銀行名
270
+
271
+ readList.Add Trim(Mid(strBuff, 24, 19)) '支店名
272
+
273
+ readList.Add Trim(Mid(strBuff, 2, 4)) '銀行コード
274
+
275
+ readList.Add Trim(Mid(strBuff, 21, 3)) '支店コード
276
+
277
+ readList.Add Trim(Mid(strBuff, 43, 8)) '口座番号
278
+
279
+ readList.Add Trim(Mid(strBuff, 43, 1)) '口座種類
280
+
281
+ arrayList.Add readList '読み込んだ値をリストに格納
282
+
283
+ Set readList = New Collection 'リスト初期化
284
+
285
+
286
+
287
+ nextLine:
288
+
289
+
290
+
291
+ Loop
292
+
293
+
294
+
295
+ ' ファイルクローズ
296
+
297
+ Close #intNo
298
+
299
+
300
+
301
+ '戻り値設定
302
+
303
+ Set READ_TextFile = arrayList
304
+
305
+
306
+
307
+ End Function
308
+
309
+
310
+
311
+
312
+
313
+
314
+
315
+
316
+
317
+
318
+
319
+
320
+
321
+ 'ここからクラスモジュール
322
+
323
+
324
+
325
+
326
+
327
+
328
+
329
+
330
+
331
+ 'クラスモジュールcommon
332
+
333
+ Public Function getMaxRow(ByVal sheetName As String, ByVal cal As Long) As Long
334
+
335
+ '最大行取得
336
+
337
+ Dim maxRow As Long
338
+
339
+
340
+
341
+ '下から
342
+
343
+ maxRow = ThisWorkbook.Sheets(sheetName).Cells(Rows.count, cal).End(xlUp).row
344
+
345
+
346
+
347
+ '結果を返却
348
+
349
+ getMaxRow = maxRow
350
+
351
+
352
+
353
+ End Function
354
+
355
+
356
+
357
+ Public Function getDataList(ByVal sheetName As String, ByVal startRow As Long, ByVal cal As Long) As Collection
358
+
359
+ 'データリスト取得
360
+
361
+ Dim resultList As Collection
362
+
363
+ Set resultList = New Collection
364
+
365
+
366
+
367
+ '最大行取得
368
+
369
+ Dim maxRow As Long
370
+
371
+ maxRow = getMaxRow(sheetName, cal)
372
+
373
+
374
+
375
+ '最大行まで取得
376
+
377
+ Dim takeData As String
378
+
379
+ Dim count As Long
380
+
381
+ For count = startRow To maxRow
382
+
383
+ takeData = ThisWorkbook.Sheets(sheetName).Cells(count, cal).Value
384
+
385
+ resultList.Add takeData
386
+
387
+ Next count
388
+
389
+
390
+
391
+ '結果を返却
392
+
393
+ Set getDataList = resultList
394
+
395
+
396
+
397
+ End Function
398
+
399
+
400
+
401
+
402
+
403
+
404
+
405
+
406
+
407
+
408
+
409
+
410
+
411
+
412
+
413
+ 'クラスモジュールsearchName
414
+
415
+
416
+
17
417
  Public Function executeSeach(ByVal inputDataList As Collection, ByVal nameList As Collection) As Collection
18
418
 
19
419
  '読み込んだデータリストから部分一致で名前を検索し、