質問編集履歴
5
質問内容を変更しました
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -5,6 +5,10 @@
|
|
|
5
5
|
わからないなりに書き換えてみましたが、Public Sub executeSeachAndOutput(ByVal inputDataList As Variant)
|
|
6
6
|
の部分で処理が止まってしまいます
|
|
7
7
|
どのようにすればいいか、どこを改修すればいいのかヒントでもいいので教えていただきたいです
|
|
8
|
+
|
|
9
|
+
また、こうした処理をする場合、テキストボックスを使用するのとセルに入力してもらうのとどちらの形の方が作りやすいですか?
|
|
10
|
+
|
|
11
|
+
|
|
8
12
|
```VBA
|
|
9
13
|
'標準モジュール
|
|
10
14
|
|
4
searchNameの部分を書き換えました
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -1,10 +1,10 @@
|
|
|
1
1
|
質問失礼いたします
|
|
2
2
|
プログラミングの経験がなく、VBA自体を初めて触るものです
|
|
3
|
-
VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業をしたいのですが、やりたい事としては
|
|
4
|
-
|
|
3
|
+
VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業ですが、excelワークシートに入力する場所を３０枠用意し、間に空白のセルがあってもちゃんと検索し、出力できるようにしたいです
|
|
5
|
-
(2)同一の名字が複数人いる場合、該当者がいない場合、全角文字がつかわれている場合、苗字ではなく名前のみで検索されている場合というそれぞれの場合でエラーメッセージを出す（エラーが起こったら、処理をそこで停止する）
|
|
6
|
-
という二つが出来る様に改修をしたいのですが、どの部分を改修すればよいかアドバイスをお願いします
|
|
7
4
|
|
|
5
|
+
わからないなりに書き換えてみましたが、Public Sub executeSeachAndOutput(ByVal inputDataList As Variant)
|
|
6
|
+
の部分で処理が止まってしまいます
|
|
7
|
+
どのようにすればいいか、どこを改修すればいいのかヒントでもいいので教えていただきたいです
|
|
8
8
|
```VBA
|
|
9
9
|
'標準モジュール
|
|
10
10
|
|
|
@@ -206,30 +206,29 @@
|
|
|
206
206
|
|
|
207
207
|
'クラスモジュールsearchName
|
|
208
208
|
|
|
209
|
-
Public Function executeSeach(ByVal inputDataList As
|
|
209
|
+
Public Function executeSeach(ByVal inputDataList As Variant, ByVal nameList As Variant) As Variant
|
|
210
|
-
|
|
210
|
+
|
|
211
|
-
'一致したデータ行をリストに格納
|
|
212
|
-
'名前から部分一致するリストをリストとして格納
|
|
213
|
-
Dim hitDataList As
|
|
211
|
+
Dim hitDataList(29) As Variant
|
|
214
|
-
|
|
212
|
+
|
|
215
|
-
Dim inputItemList As
|
|
213
|
+
Dim inputItemList(29) As Variant
|
|
216
|
-
|
|
214
|
+
|
|
217
|
-
Dim inputNameData As
|
|
215
|
+
Dim inputNameData(29) As Variant
|
|
218
|
-
Dim nameItem As Variant
|
|
216
|
+
Dim nameItem(29) As Variant
|
|
219
|
-
Dim nameData As
|
|
217
|
+
Dim nameData(29) As Variant
|
|
220
|
-
|
|
218
|
+
|
|
219
|
+
|
|
221
|
-
For Each inputItemList In
|
|
220
|
+
For Each inputItemList In Range("B12:B41")
|
|
222
|
-
|
|
221
|
+
nameData = inputItemList.Item
|
|
223
|
-
|
|
222
|
+
|
|
223
|
+
|
|
224
|
-
|
|
224
|
+
For Each nameItem In nameList
|
|
225
225
|
If InStr(nameData, nameItem) <> 0 Then
|
|
226
226
|
hitDataList.Add inputItemList
|
|
227
227
|
End If
|
|
228
228
|
Next nameItem
|
|
229
|
-
|
|
229
|
+
|
|
230
|
-
'結果を返却
|
|
231
|
-
Set executeSeach = hitDataList
|
|
232
|
-
End Function
|
|
230
|
+
End Function
|
|
231
|
+
|
|
233
232
|
```
|
|
234
233
|
|
|
235
234
|
以上について回答宜しくお願いします
|
3
質問内容を変更しました
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -1,5 +1,5 @@
|
|
|
1
1
|
質問失礼いたします
|
|
2
|
-
|
|
2
|
+
プログラミングの経験がなく、VBA自体を初めて触るものです
|
|
3
3
|
VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業をしたいのですが、やりたい事としては
|
|
4
4
|
(1)excelワークシートに入力する場所を３０枠用意し、間に空白のセルがあってもちゃんと検索し、出力できるようにする
|
|
5
5
|
(2)同一の名字が複数人いる場合、該当者がいない場合、全角文字がつかわれている場合、苗字ではなく名前のみで検索されている場合というそれぞれの場合でエラーメッセージを出す（エラーが起こったら、処理をそこで停止する）
|
2
質問内容を変更しました
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -1,7 +1,7 @@
|
|
|
1
1
|
質問失礼いたします
|
|
2
2
|
|
|
3
3
|
VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業をしたいのですが、やりたい事としては
|
|
4
|
-
(1)入力
|
|
4
|
+
(1)excelワークシートに入力する場所を３０枠用意し、間に空白のセルがあってもちゃんと検索し、出力できるようにする
|
|
5
5
|
(2)同一の名字が複数人いる場合、該当者がいない場合、全角文字がつかわれている場合、苗字ではなく名前のみで検索されている場合というそれぞれの場合でエラーメッセージを出す（エラーが起こったら、処理をそこで停止する）
|
|
6
6
|
という二つが出来る様に改修をしたいのですが、どの部分を改修すればよいかアドバイスをお願いします
|
|
7
7
|
|
1
ファイルの読み込みをしていたモジュールの追加をしました
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -2,10 +2,210 @@
|
|
|
2
2
|
|
|
3
3
|
VBAを使って口座情報のtxtファイルを管理するプログラムの改修作業をしたいのですが、やりたい事としては
|
|
4
4
|
(1)入力枠を３０枠用意し、間に空白の枠があってもちゃんと出力できるようにする
|
|
5
|
-
(2)同一の名字
|
|
5
|
+
(2)同一の名字が複数人いる場合、該当者がいない場合、全角文字がつかわれている場合、苗字ではなく名前のみで検索されている場合というそれぞれの場合でエラーメッセージを出す（エラーが起こったら、処理をそこで停止する）
|
|
6
|
-
という二つが出来る様に改修をしたいのですが、どの
|
|
6
|
+
という二つが出来る様に改修をしたいのですが、どの部分を改修すればよいかアドバイスをお願いします
|
|
7
|
-
|
|
7
|
+
|
|
8
8
|
```VBA
|
|
9
|
+
'標準モジュール
|
|
10
|
+
|
|
11
|
+
'ファイル取得処理
|
|
12
|
+
Public Sub GET_TextFile()
|
|
13
|
+
Dim objFS As Object
|
|
14
|
+
Dim strPath As String
|
|
15
|
+
Dim strFile As String
|
|
16
|
+
Dim strFolder As String
|
|
17
|
+
Dim ofdFolderDlg As Office.FileDialog
|
|
18
|
+
|
|
19
|
+
strPath = Range("selectFileName").Value
|
|
20
|
+
Set objFS = CreateObject("Scripting.FileSystemObject")
|
|
21
|
+
|
|
22
|
+
' 初期パスの設定
|
|
23
|
+
If Len(strPath) > 0 Then
|
|
24
|
+
' 末尾の"\"削除
|
|
25
|
+
If Right(strPath, 1) = "\" Then
|
|
26
|
+
strPath = Left(strPath, Len(strPath) - 1)
|
|
27
|
+
End If
|
|
28
|
+
|
|
29
|
+
' ファイルが存在
|
|
30
|
+
If objFS.FileExists(strPath) Then
|
|
31
|
+
' ファイル名のみ取得
|
|
32
|
+
strFile = objFS.GetFileName(strPath)
|
|
33
|
+
' フォルダパスのみ取得
|
|
34
|
+
strFolder = objFS.GetParentFolderName(strPath)
|
|
35
|
+
' ファイルが存在しない
|
|
36
|
+
Else
|
|
37
|
+
' フォルダが存在
|
|
38
|
+
If objFS.FolderExists(strPath) Then
|
|
39
|
+
strFile = ""
|
|
40
|
+
strFolder = strPath
|
|
41
|
+
' フォルダが存在しない
|
|
42
|
+
Else
|
|
43
|
+
' ファイル名のみ取得
|
|
44
|
+
strFile = objFS.GetFileName(strPath)
|
|
45
|
+
' 親フォルダを取得
|
|
46
|
+
strFolder = objFS.GetParentFolderName(strPath)
|
|
47
|
+
' 親フォルダが存在しない
|
|
48
|
+
If Not objFS.FolderExists(strFolder) Then
|
|
49
|
+
strFolder = ThisWorkbook.Path
|
|
50
|
+
End If
|
|
51
|
+
End If
|
|
52
|
+
End If
|
|
53
|
+
Set objFS = Nothing
|
|
54
|
+
Else
|
|
55
|
+
strFolder = ThisWorkbook.Path
|
|
56
|
+
strFile = ""
|
|
57
|
+
End If
|
|
58
|
+
|
|
59
|
+
' ファイル選択ダイアログ設定
|
|
60
|
+
Set ofdFileDlg = Application.FileDialog(msoFileDialogFilePicker)
|
|
61
|
+
With ofdFileDlg
|
|
62
|
+
.ButtonName = "選択"
|
|
63
|
+
'「ファイルの種類」をクリア
|
|
64
|
+
.Filters.Clear
|
|
65
|
+
'「ファイルの種類」を登録
|
|
66
|
+
.Filters.Add "テキストファイル", "*.txt", 1
|
|
67
|
+
.Filters.Add "全ファイル", "*.*", 2
|
|
68
|
+
|
|
69
|
+
' 初期フォルダ
|
|
70
|
+
.InitialFileName = strFolder & "\" & strFile
|
|
71
|
+
' 複数選択不可
|
|
72
|
+
.AllowMultiSelect = False
|
|
73
|
+
'表示するアイコンの大きさを指定
|
|
74
|
+
.InitialView = msoFileDialogViewDetails
|
|
75
|
+
End With
|
|
76
|
+
|
|
77
|
+
|
|
78
|
+
|
|
79
|
+
' フォルダ選択ダイアログ表示
|
|
80
|
+
If ofdFileDlg.Show() = -1 Then
|
|
81
|
+
' フォルダパス設定
|
|
82
|
+
strPath = ofdFileDlg.SelectedItems(1)
|
|
83
|
+
Else
|
|
84
|
+
' キャンセルされた場合以降の処理は行なわない
|
|
85
|
+
Exit Sub
|
|
86
|
+
End If
|
|
87
|
+
|
|
88
|
+
Range("selectFileName").Value = strPath
|
|
89
|
+
Dim all As New Collection
|
|
90
|
+
Set all = New Collection
|
|
91
|
+
Set all = READ_TextFile(strPath)
|
|
92
|
+
|
|
93
|
+
'検索出力実行
|
|
94
|
+
Dim main As New suzukiMain
|
|
95
|
+
Call main.executeSeachAndOutput(all)
|
|
96
|
+
Set ofdFileDlg = Nothing
|
|
97
|
+
|
|
98
|
+
MsgBox "CSVファイルを" & Chr(13) & strPath & Chr(13) & "に出力完了しました。"
|
|
99
|
+
|
|
100
|
+
End Sub
|
|
101
|
+
' ファイルの読み込み処理
|
|
102
|
+
'配列に格納する処理
|
|
103
|
+
Private Function READ_TextFile(ByVal strPathName As String) As Collection
|
|
104
|
+
Dim intNo As Integer
|
|
105
|
+
Dim objFS As Object
|
|
106
|
+
Dim strBuff As String
|
|
107
|
+
strPath = strPathName
|
|
108
|
+
|
|
109
|
+
Set objFS = CreateObject("Scripting.FileSystemObject")
|
|
110
|
+
|
|
111
|
+
If objFS.FileExists(strPath) = False Then
|
|
112
|
+
Exit Function
|
|
113
|
+
End If
|
|
114
|
+
|
|
115
|
+
' ファイルオープン
|
|
116
|
+
intNo = FreeFile() ' フリーファイルNoを取得
|
|
117
|
+
Open strPathName For Input As #intNo ' ファイルをオープン
|
|
118
|
+
|
|
119
|
+
' ファイルの読み込み
|
|
120
|
+
Dim arrayList As New Collection
|
|
121
|
+
Set arrayList = New Collection
|
|
122
|
+
Dim readList As New Collection
|
|
123
|
+
Set readList = New Collection
|
|
124
|
+
|
|
125
|
+
Do Until EOF(intNo) ' ファイルの最後までループ
|
|
126
|
+
|
|
127
|
+
Line Input #intNo, strBuff ' ファイルから一行読み込み
|
|
128
|
+
|
|
129
|
+
|
|
130
|
+
If Left(strBuff, 1) <> 2 Then '区分コードが2以外の場合次の行へ
|
|
131
|
+
GoTo nextLine
|
|
132
|
+
End If
|
|
133
|
+
|
|
134
|
+
readList.Add Trim(Mid(strBuff, 51, 30)) '氏名
|
|
135
|
+
readList.Add Trim(Mid(strBuff, 6, 15)) '銀行名
|
|
136
|
+
readList.Add Trim(Mid(strBuff, 24, 19)) '支店名
|
|
137
|
+
readList.Add Trim(Mid(strBuff, 2, 4)) '銀行コード
|
|
138
|
+
readList.Add Trim(Mid(strBuff, 21, 3)) '支店コード
|
|
139
|
+
readList.Add Trim(Mid(strBuff, 43, 8)) '口座番号
|
|
140
|
+
readList.Add Trim(Mid(strBuff, 43, 1)) '口座種類
|
|
141
|
+
arrayList.Add readList '読み込んだ値をリストに格納
|
|
142
|
+
Set readList = New Collection 'リスト初期化
|
|
143
|
+
|
|
144
|
+
nextLine:
|
|
145
|
+
|
|
146
|
+
Loop
|
|
147
|
+
|
|
148
|
+
' ファイルクローズ
|
|
149
|
+
Close #intNo
|
|
150
|
+
|
|
151
|
+
'戻り値設定
|
|
152
|
+
Set READ_TextFile = arrayList
|
|
153
|
+
|
|
154
|
+
End Function
|
|
155
|
+
|
|
156
|
+
|
|
157
|
+
|
|
158
|
+
|
|
159
|
+
|
|
160
|
+
|
|
161
|
+
'ここからクラスモジュール
|
|
162
|
+
|
|
163
|
+
|
|
164
|
+
|
|
165
|
+
|
|
166
|
+
'クラスモジュールcommon
|
|
167
|
+
Public Function getMaxRow(ByVal sheetName As String, ByVal cal As Long) As Long
|
|
168
|
+
'最大行取得
|
|
169
|
+
Dim maxRow As Long
|
|
170
|
+
|
|
171
|
+
'下から
|
|
172
|
+
maxRow = ThisWorkbook.Sheets(sheetName).Cells(Rows.count, cal).End(xlUp).row
|
|
173
|
+
|
|
174
|
+
'結果を返却
|
|
175
|
+
getMaxRow = maxRow
|
|
176
|
+
|
|
177
|
+
End Function
|
|
178
|
+
|
|
179
|
+
Public Function getDataList(ByVal sheetName As String, ByVal startRow As Long, ByVal cal As Long) As Collection
|
|
180
|
+
'データリスト取得
|
|
181
|
+
Dim resultList As Collection
|
|
182
|
+
Set resultList = New Collection
|
|
183
|
+
|
|
184
|
+
'最大行取得
|
|
185
|
+
Dim maxRow As Long
|
|
186
|
+
maxRow = getMaxRow(sheetName, cal)
|
|
187
|
+
|
|
188
|
+
'最大行まで取得
|
|
189
|
+
Dim takeData As String
|
|
190
|
+
Dim count As Long
|
|
191
|
+
For count = startRow To maxRow
|
|
192
|
+
takeData = ThisWorkbook.Sheets(sheetName).Cells(count, cal).Value
|
|
193
|
+
resultList.Add takeData
|
|
194
|
+
Next count
|
|
195
|
+
|
|
196
|
+
'結果を返却
|
|
197
|
+
Set getDataList = resultList
|
|
198
|
+
|
|
199
|
+
End Function
|
|
200
|
+
|
|
201
|
+
|
|
202
|
+
|
|
203
|
+
|
|
204
|
+
|
|
205
|
+
|
|
206
|
+
|
|
207
|
+
'クラスモジュールsearchName
|
|
208
|
+
|
|
9
209
|
Public Function executeSeach(ByVal inputDataList As Collection, ByVal nameList As Collection) As Collection
|
|
10
210
|
'読み込んだデータリストから部分一致で名前を検索し、
|
|
11
211
|
'一致したデータ行をリストに格納
|