teratail
回答率
85.30%
teratail header banner
teratail header banner
質問するログイン新規登録
トップに関する質問VBA 複数条件

編集履歴

質問編集履歴

2

コード追加

2020/08/12 05:37

投稿

yakumo02
yakumo02

スコア103

title CHANGED
File without changes
body CHANGED
@@ -76,72 +76,133 @@
76
76
 
77
77
  コード
78
78
  ```
79
- グローバル変数 仮で200
79
+ グローバル関数
80
- Dim Sheet(200) As String 'ファイルのパスとシート名(book.xlsxなど)が合わさったものを格納の配列
80
+ Dim Sheet(200) As String
81
- Dim Sheet_path(200) 'ファイルのパスだけ配列に格納
81
+ Dim Sheet_path(200)
82
82
  Dim b As Long
83
+ Dim c As Long
84
+ Dim kekka
85
+ Dim neko
83
86
  Dim a As Long
84
87
 
88
+ sub call
89
+ Call FileSearch("C:\Users\katou-ken\Documents\Document\25_設計書")
90
+
91
+ End sub
92
+
93
+ 'SheetとSheet_pathに比較ファイルのデータとパスを入れる
94
+ Sub FileSearch(path As String)
95
+
96
+ Dim FSO As Object, Folder As Variant, File As Variant, buf As String, this As Worksheet
97
+
98
+ Set FSO = CreateObject("Scripting.FileSystemObject")
99
+ Set this = ThisWorkbook.Worksheets("イベント")
100
+
101
+
102
+ buf = Dir(path & "*サンプル.xls*")
103
+
104
+
105
+ Do While buf <> ""
106
+
107
+ Sheet(b) = buf
108
+ Sheet_path(b) = path
109
+
110
+ b = b + 1
111
+ buf = Dir()
112
+
113
+
114
+ If b > 178 Then
115
+
116
+ Call hikaku
117
+
118
+ End If
119
+
120
+ Loop
121
+
122
+
123
+ For Each Folder In FSO.GetFolder(path).SubFolders
124
+ Call FileSearch(Folder.path)
125
+ Next Folder
126
+
127
+
128
+
129
+
130
+ End Sub
131
+
132
+
85
133
  Sub hikaku()
86
134
 
87
135
  Set this = ThisWorkbook.Worksheets("イベント")
136
+ 'MsgBox Sheet_path(4)
88
137
 
89
138
 
90
139
 
91
140
  a = 1
92
141
  e = 2
93
- c = 1
142
+ c = 1
94
143
  d = 1
95
144
 
96
145
 
97
- this_line = this.Cells(Rows.Count, 7).End(xlUp).Row 'G列のデータの最終行を取得
146
+ this_line = this.Cells(Rows.Count, 7).End(xlUp).Row 'AファイルG列の最終行の行番号
98
147
 
99
148
 
100
- Do While this_line > a 'AファイルのG列のデータ分だけループ
149
+ Do While this_line > a 'AファイルのG列の末端までループ
101
150
 
102
- target = this.Cells(e, 7).Value '(AファイルG列のデータを取得)
151
+ target = this.Cells(e, 7).Value 'AファイルG列の文字を取得
103
152
 
104
- Do While UBound(Sheet) > d '配列の要素数分だけ繰り返し
153
+ Do While UBound(Sheet) > d '配列の要素数分だけ取得
105
154
 
106
- filename = Sheet(c) '配列に入っているデータ(比較ファイルのパス)を変数に格納
155
+ filename = Sheet(c)
107
156
 
157
+
158
+
159
+
108
- '関数呼び出し
160
+ '現在考え中の処理2と処理1
109
- 　 If target Like "初期" And shori(target,filename) = False
161
+ If target Like "初期" Then
162
+
163
+ Call IsContained(target, filename)
164
+
165
+ If kekka = True Then
166
+ this.Cells(e, 8).Value = "一致"
167
+ Else
110
- this.Cells(e, 8).Value = "一致なし"
168
+ this.Cells(e, 8).Value = "一致なし"
169
+ End If
111
170
  Else
112
- this.Cells(e, 8).Value = "一致"
113
- 　　　　Endif
171
+ End If
114
-
172
+
115
- If Not target Like "初期" And IsContained(target, filename) = True Then '戻り値がTrueだった場合
173
+ If Not target Like "初期" Then
116
-
174
+ Call shori(target, filename)
175
+
176
+ If neko = True Then
117
177
  this.Cells(e, 8).Value = "一致"
178
+
118
-
179
+ Else
180
+ this.Cells(e, 8).Value = "不一致"
119
- Exit Do
181
+ End If
120
-
121
182
  Else
122
- this.Cells(e, 8).Value = "不一致"
123
-
124
183
  End If
125
-
184
+
185
+
126
186
  d = d + 1
127
187
  c = c + 1
128
-
188
+
129
189
  Loop
130
190
  d = 1
131
191
  c = 2
132
- b = b + 1
192
+ e = e + 1
133
193
  a = a + 1
134
194
  Loop
135
195
 
136
196
  End Sub
137
- '関数
138
- Function IsContained(target, filename) As Boolean　'関数
139
197
 
198
+ Function IsContained(target, filename) As Boolean
199
+
200
+
140
- path = Sheet_path(b) 'パスだけ変数に代入
201
+ path = Sheet_path(c)
141
- '######ここで開く処理
202
+
142
203
  Set open_file = Workbooks.Open(filename:=path & "\" & filename, UpdateLinks:=False)
143
204
 
144
- this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row　`比較ファイルのデータの最終行を取得
205
+ this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row
145
206
 
146
207
  i = 1
147
208
  j = 10
@@ -149,30 +210,73 @@
149
210
 
150
211
  Application.ScreenUpdating = False
151
212
 
152
- Do While this_line / 2 > i 'データ数分だけ繰り返し　セルが結合してあるので2で割る
213
+ Do While this_line / 2 > i '最終行までループ
153
214
 
215
+ ThisWorkbook.Activate
154
216
 
217
+ If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then '比較ファイルにAファイルと同じデータが存在するなら
218
+
219
+
220
+ kekka = True
221
+
222
+ Exit Do
223
+
224
+ Else
225
+
226
+ i = i + 1
227
+ j = j + 2
228
+
229
+ End If
230
+ kekka = False
231
+ Loop
232
+ Workbooks(filename).Close
155
233
 
156
- ThisWorkbook.Activate
157
234
 
235
+ Application.ScreenUpdating = True
236
+ End Function
158
237
 
159
- If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then 'AファイルG列のデータが、比較ファイルにあれば
160
- IsContained = True
161
238
 
162
- Exit Do
163
239
 
240
+ Function shori(target, filename) As Boolean
164
241
 
242
+
243
+ path = Sheet_path(c)
244
+
245
+ Set open_file = Workbooks.Open(filename:=path & "\" & filename, UpdateLinks:=False)
246
+
247
+ this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row
248
+
249
+ i = 1
250
+ j = 10
251
+
252
+
253
+ Application.ScreenUpdating = False
254
+
255
+ Do While this_line / 2 > i 'filename???I?s-9 =i ??(?w?????t?@?C????S?s?????????????[?v)
256
+
257
+ 'Set open_file = Workbooks.Open(filename:=path & "\" & filename, UpdateLinks:=False)
258
+
259
+ ThisWorkbook.Activate
260
+
261
+ If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then '
262
+
263
+
264
+ neko = True
265
+
266
+ Exit Do
267
+
165
268
  Else
166
-
269
+
167
270
  i = i + 1
168
271
  j = j + 2
169
-
272
+
170
273
  End If
171
- IsContained = False
274
+ neko = False
172
275
  Loop
173
276
  Workbooks(filename).Close
174
277
 
175
278
 
176
279
  Application.ScreenUpdating = True
177
280
  End Function
281
+
178
282
  ```

1

l

2020/08/12 05:37

投稿

yakumo02
yakumo02

スコア103

title CHANGED
File without changes
body CHANGED
@@ -64,8 +64,8 @@
64
64
  |:--|:--:|--:|
65
65
  1||初期|一致|
66
66
  2||テスト|一致|
67
- 3||アクション|不一致|
67
+ 3||API|不一致|
68
- 4||イベント|不一致|
68
+ 4||LINE|不一致|
69
69
  5||デバッグ|一致|
70
70
 
71
71