質問編集履歴

1

ソースコードを一部記載から全て記載に修正致しました。

2017/05/02 04:43

投稿

Susanoo2442
Susanoo2442

スコア153

test CHANGED
File without changes
test CHANGED
@@ -8,29 +8,467 @@
8
8
 
9
9
  ```エクセルVBA
10
10
 
11
+ Dim Search As String
12
+
13
+
14
+
15
+ Private Sub CommandButton1_Click()
16
+
17
+ Dim ELInteger2 As Integer
18
+
19
+ Dim ELInteger As Integer
20
+
21
+ Dim ELStringer5 As String
22
+
23
+ Dim ELStringer4 As String
24
+
25
+ Dim ELStringer3 As String
26
+
27
+ Dim ELStringer2 As String
28
+
29
+ Dim ELStringer As String
30
+
31
+ Dim SPDate3 As String
32
+
33
+ Dim SPDate2 As String
34
+
35
+ Dim SPDate As String
36
+
37
+ Dim Colect5 As IHTMLElementCollection
38
+
39
+ Dim Colect4 As IHTMLElementCollection
40
+
41
+ Dim Colect3 As IHTMLElementCollection
42
+
43
+ Dim Colect2 As IHTMLElementCollection
44
+
45
+ Dim Colect As IHTMLElementCollection
46
+
47
+ Dim interNet5 As InternetExplorer
48
+
49
+ Dim interNet4 As InternetExplorer
50
+
51
+ Dim interNet3 As InternetExplorer
52
+
53
+ Dim interNet2 As InternetExplorer
54
+
55
+ Dim interNet As InternetExplorer
56
+
57
+ Dim HTMLD4 As HTMLDocument
58
+
59
+ Dim HTMLD3 As HTMLDocument
60
+
61
+ Dim HTMLD2 As HTMLDocument
62
+
63
+ Dim HTMLD As HTMLDocument
64
+
65
+ Dim Sisokuenzan As String
66
+
67
+ Dim kasan As String
68
+
69
+ Dim ELInteger10 As Integer
70
+
71
+
72
+
73
+ ELInteger10 = 0
74
+
75
+ ELIntegerB = 0
76
+
77
+ ELIntegerC = 0
78
+
79
+ ELInteger = 0
80
+
81
+
82
+
83
+ ELIntegerCount6 = 4
84
+
85
+ ELIntegerCount5 = 4
86
+
87
+ ELIntegerCount4 = 4
88
+
89
+
90
+
91
+ ELIntegerCount3 = 4
92
+
93
+ ELIntegerCount2 = 4
94
+
95
+ ELIntegerCount1 = 4
96
+
97
+
98
+
99
+ Dim ELIntegerCountStringer1 As String
100
+
101
+ Dim ELIntegerCountStringer2 As String
102
+
103
+ Dim ELIntegerCountStringer3 As String
104
+
105
+ Dim ELIntegerCountStringer4 As String
106
+
107
+ Dim ELIntegerCountStringer5 As String
108
+
109
+ Dim ELIntegerCountStringer6 As String
110
+
111
+
112
+
113
+ 'ブランド抽出処理
114
+
115
+ Set interNet2 = CreateObject("Internetexplorer.Application")
116
+
117
+ interNet2.Visible = False
118
+
119
+ kasan = ".html"
120
+
121
+ Sisokuenzan = Search + kasan
122
+
123
+ interNet2.navigate "http://www.buyma.com/brand/" & Sisokuenzan
124
+
125
+
126
+
127
+ Do While interNet2.Busy = True Or interNet2.readyState < READYSTATE_COMPLETE
128
+
129
+ DoEvents
130
+
131
+ Loop
132
+
133
+
134
+
135
+ Set HTMLD = interNet2.document
136
+
137
+ Set Colect = HTMLD.getElementsByClassName("vmimg_120")
138
+
139
+
140
+
141
+ '各ブランドのバイヤーTop3展開処理
142
+
143
+ For Each EL In Colect
144
+
145
+ SPDate = EL.innerHTML
146
+
147
+ ELStringer = Mid(SPDate, 95)
148
+
149
+ ELInteger = InStr(ELStringer, "l")
150
+
151
+ ELStringer2 = Left(ELStringer, ELInteger)
152
+
153
+
154
+
155
+ '各ブランドのTop3バイヤー取得処理
156
+
157
+ Set interNet3 = CreateObject("Internetexplorer.Application")
158
+
159
+ interNet3.Visible = False
160
+
161
+ interNet3.navigate ELStringer2
162
+
163
+
164
+
165
+ Do While interNet3.Busy = True Or interNet3.readyState < READYSTATE_COMPLETE
166
+
167
+ DoEvents
168
+
169
+ Loop
170
+
171
+
172
+
173
+ Set HTMLD2 = interNet3.document
174
+
175
+ Set Colect2 = HTMLD2.getElementsByClassName("profimg_wrap")
176
+
177
+
178
+
179
+ '各ブランドのTop3バイヤー表示処理
180
+
181
+ For Each El2 In Colect2
182
+
183
+ SPDate2 = El2.innerHTML
184
+
185
+ ELStringer3 = Mid(SPDate2, 14)
186
+
187
+ ELInteger2 = InStr(ELStringer3, "http")
188
+
189
+ ELInteger4 = ELInteger2
190
+
191
+ ELStringer4 = Left(ELStringer3, ELInteger4)
192
+
193
+ ELIntegerA = InStr(ELStringer4, "alt") + 5
194
+
195
+ ELInteger6 = InStr(ELIntegerA, ELStringer4, """")
196
+
197
+ ELInteger8 = ELInteger6 - ELIntegerA
198
+
199
+ ELStringer5 = Mid(ELStringer4, ELIntegerA, ELInteger8)
200
+
201
+ Next El2
202
+
203
+
204
+
205
+ 'ランキング表示処理
206
+
207
+ ELInteger10 = ELInteger10 + 1
208
+
209
+ If ELInteger10 = 1 Then
210
+
211
+ Range("A1").Value = "ランキング1位:" & ELStringer5
212
+
213
+ ElseIf ELInteger10 = 2 Then
214
+
215
+ Range("D1").Value = "ランキング2位:" & ELStringer5
216
+
217
+ ElseIf ELInteger10 = 3 Then
218
+
219
+ Range("G1").Value = "ランキング3位:" & ELStringer5
220
+
221
+ End If
222
+
223
+
224
+
225
+ 'バイヤー別売上ランキング取得処理
226
+
227
+ ELInteger12 = InStr(ELStringer4, ".html") - 1
228
+
229
+ ELStringer13 = Left(ELStringer4, ELInteger12)
230
+
231
+
232
+
233
+ Set interNet4 = CreateObject("Internetexplorer.Application")
234
+
235
+ interNet4.Visible = False
236
+
237
+ interNet4.navigate "http://www.buyma.com/" & ELStringer13 + "/sales_1.html"
238
+
239
+
240
+
241
+ Do While interNet4.Busy = True Or interNet4.readyState < READYSTATE_COMPLETE
242
+
243
+ DoEvents
244
+
245
+ Loop
246
+
247
+
248
+
249
+ Set HTMLD3 = interNet4.document
250
+
251
+ Set Colect3 = HTMLD3.getElementsByClassName("data_line0")
252
+
253
+ Set HTMLD4 = interNet4.document
254
+
255
+ Set Colect4 = HTMLD4.getElementsByClassName("data_line1")
256
+
257
+
258
+
259
+ 'デバッキング処理
260
+
261
+ For Each ELD In Colect3
262
+
263
+ ELStringer15 = ELD.innerHTML
264
+
265
+ Debug.Print ELStringer15
266
+
267
+ ELStringer17 = Mid(ELStringer15, 168)
268
+
269
+ Debug.Print ELInteger17
270
+
271
+ ELInteger18 = InStr(ELStringer17, """>")
272
+
273
+ Debug.Print ELInteger18
274
+
275
+ ELStringer20 = Left(ELStringer17, ELInteger18)
276
+
277
+ Debug.Print ELStringer20
278
+
279
+ ELInteger100 = Len(ELStringer20)
280
+
281
+ ELInteger200 = ELInteger100 - 2
282
+
283
+ ELStringer24 = Left(ELStringer20, ELInteger200)
284
+
285
+ Debug.Print ELStringer24
286
+
287
+ ELInteger2000 = Len(ELStringer24)
288
+
289
+ ELInteger4000 = ELInteger2000 - 15
290
+
291
+ ELStringer1000 = Right(ELStringer24, ELInteger4000)
292
+
293
+ Debug.Print ELStringer1000
294
+
295
+ Set interNet5 = CreateObject("Internetexplorer.Application")
296
+
297
+ interNet5.Visible = False
298
+
299
+ interNet5.navigate "http://www.buyma.com/item/" & ELStringer1000
300
+
301
+ Next ELD
302
+
303
+
304
+
305
+ '商品リスト展開メインルーチン
306
+
307
+ ELIntegerB = ELIntegerB + 1
308
+
309
+ If ELIntegerB = 1 Then
310
+
311
+ For Each El3 In Colect3
312
+
313
+ ELIntegerCount1 = ELIntegerCount1 + 1
314
+
315
+ ELIntegerCountStringer1 = ELIntegerCount1
316
+
317
+ SPDate10 = El3.innerText
318
+
319
+ Range("A" & ELIntegerCountStringer1).Value = SPDate10
320
+
321
+ Next El3
322
+
323
+
324
+
325
+ ElseIf ELIntegerB = 2 Then
326
+
327
+ For Each El4 In Colect3
328
+
329
+ ELIntegerCount2 = ELIntegerCount2 + 1
330
+
331
+ ELIntegerCountStringer2 = ELIntegerCount2
332
+
333
+ SPDate10 = El4.innerText
334
+
335
+ Range("C" & ELIntegerCountStringer2).Value = SPDate10
336
+
337
+ Next El4
338
+
339
+
340
+
341
+ ElseIf ELIntegerB = 3 Then
342
+
343
+ For Each El5 In Colect3
344
+
345
+ ELIntegerCount3 = ELIntegerCount3 + 1
346
+
347
+ ELIntegerCountStringer3 = ELIntegerCount3
348
+
349
+ SPDate10 = El5.innerText
350
+
351
+ Range("E" & ELIntegerCountStringer3).Value = SPDate10
352
+
353
+ Next El5
354
+
355
+ End If
356
+
357
+
358
+
359
+ '商品リスト2展開メインルーチン
360
+
361
+ ELIntegerC = ELIntegerC + 1
362
+
363
+ If ELIntegerC = 1 Then
364
+
365
+ For Each El6 In Colect4
366
+
367
+ ELIntegerCount4 = ELIntegerCount4 + 1
368
+
369
+ ELIntegerCountStringer4 = ELIntegerCount4
370
+
371
+ SPDate11 = El6.innerText
372
+
373
+ Range("B" & ELIntegerCountStringer4).Value = SPDate11
374
+
375
+ Next El6
376
+
377
+
378
+
379
+ ElseIf ELIntegerC = 2 Then
380
+
381
+ For Each El7 In Colect4
382
+
383
+ ELIntegerCount5 = ELIntegerCount5 + 1
384
+
385
+ ELIntegerCountStringer5 = ELIntegerCount5
386
+
387
+ SPDate11 = El7.innerText
388
+
389
+ Range("D" & ELIntegerCountStringer5).Value = SPDate11
390
+
391
+ Next El7
392
+
393
+
394
+
395
+ ElseIf ELIntegerC = 3 Then
396
+
397
+ For Each El8 In Colect4
398
+
399
+ ELIntegerCount6 = ELIntegerCount6 + 1
400
+
401
+ ELIntegerCountStringer6 = ELIntegerCount6
402
+
403
+ SPDate11 = El8.innerText
404
+
405
+ Range("F" & ELIntegerCountStringer6).Value = SPDate11
406
+
407
+ Next El8
408
+
409
+ End If
410
+
411
+
412
+
413
+ '初期化処理
414
+
11
415
  ELIntegerD = ELIntegerD + 1
12
416
 
13
417
  If ELIntegerD = 3 Then
14
418
 
15
419
 
16
420
 
421
+ ELInteger10 = 0
422
+
423
+ ELIntegerB = 0
424
+
425
+ ELIntegerC = 0
426
+
427
+ ELIntegerD = 0
428
+
429
+
430
+
17
- Dim ObjectShell As Object
431
+ 'Dim ObjectShell As Object
18
-
432
+
19
- Dim QuiteObject As Object
433
+ 'Dim QuiteObject As Object
20
-
434
+
21
- Dim CountInteger As Integer
435
+ 'Dim CountInteger As Integer
22
-
23
-
24
-
436
+
437
+
438
+
25
- Set ObjectShell = CreateObject("Shell.Application")
439
+ 'Set ObjectShell = CreateObject("Shell.Application")
26
-
440
+
27
- For CountInteger = ObjectShell.Windows.Count To 1 Step -1
441
+ 'For CountInteger = ObjectShell.Windows.Count To 1 Step -1
28
-
442
+
29
- Set QuiteObject = ObjectShell.Windows(CountInteger - 1)
443
+ 'Set QuiteObject = ObjectShell.Windows(CountInteger - 1)
30
-
444
+
31
- If Right(UCase(QuiteObject.FullName), 12) = "IEXPLORE.EXE" Then
445
+ 'If Right(UCase(QuiteObject.FullName), 12) = "IEXPLORE.EXE" Then
32
-
446
+
33
- QuiteObject.Quit
447
+ 'QuiteObject.Quit
448
+
449
+ 'End If
450
+
451
+ 'Next
452
+
453
+
454
+
455
+ Dim SHE As Object
456
+
457
+ Dim QIT As Object
458
+
459
+ Dim CIG As Integer
460
+
461
+
462
+
463
+ Set SHE = CreateObject("Shell.Application")
464
+
465
+ For CIG = SHE.Windows.Count To 1 Step -1
466
+
467
+ Set QIT = SHE.Windows(CIG - 1)
468
+
469
+ If QIT = "iexplore.exe" Then
470
+
471
+ QIT.Quit
34
472
 
35
473
  End If
36
474
 
@@ -44,6 +482,36 @@
44
482
 
45
483
 
46
484
 
485
+ 'スクレイピングスタート
486
+
487
+ Private Sub CommandButton2_Click()
488
+
489
+ End Sub
490
+
491
+
492
+
493
+ 'バイヤー抽出
494
+
495
+ Private Sub CommandButton3_Click()
496
+
497
+ End Sub
498
+
499
+
500
+
501
+ Private Sub TextBox1_Change()
502
+
503
+ Search = TextBox1.Value
504
+
505
+ End Sub
506
+
507
+
508
+
509
+ Private Sub UserForm_Click()
510
+
511
+ End Sub
512
+
513
+
514
+
47
515
  ```
48
516
 
49
517
  ここまでです。