質問編集履歴
1
ソースコードを一部記載から全て記載に修正致しました。
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -3,24 +3,258 @@
|
|
|
3
3
|
実際のコードは下記になります。
|
|
4
4
|
以下エクセルVBAのコードになります。
|
|
5
5
|
```エクセルVBA
|
|
6
|
+
Dim Search As String
|
|
7
|
+
|
|
8
|
+
Private Sub CommandButton1_Click()
|
|
9
|
+
Dim ELInteger2 As Integer
|
|
10
|
+
Dim ELInteger As Integer
|
|
11
|
+
Dim ELStringer5 As String
|
|
12
|
+
Dim ELStringer4 As String
|
|
13
|
+
Dim ELStringer3 As String
|
|
14
|
+
Dim ELStringer2 As String
|
|
15
|
+
Dim ELStringer As String
|
|
16
|
+
Dim SPDate3 As String
|
|
17
|
+
Dim SPDate2 As String
|
|
18
|
+
Dim SPDate As String
|
|
19
|
+
Dim Colect5 As IHTMLElementCollection
|
|
20
|
+
Dim Colect4 As IHTMLElementCollection
|
|
21
|
+
Dim Colect3 As IHTMLElementCollection
|
|
22
|
+
Dim Colect2 As IHTMLElementCollection
|
|
23
|
+
Dim Colect As IHTMLElementCollection
|
|
24
|
+
Dim interNet5 As InternetExplorer
|
|
25
|
+
Dim interNet4 As InternetExplorer
|
|
26
|
+
Dim interNet3 As InternetExplorer
|
|
27
|
+
Dim interNet2 As InternetExplorer
|
|
28
|
+
Dim interNet As InternetExplorer
|
|
29
|
+
Dim HTMLD4 As HTMLDocument
|
|
30
|
+
Dim HTMLD3 As HTMLDocument
|
|
31
|
+
Dim HTMLD2 As HTMLDocument
|
|
32
|
+
Dim HTMLD As HTMLDocument
|
|
33
|
+
Dim Sisokuenzan As String
|
|
34
|
+
Dim kasan As String
|
|
35
|
+
Dim ELInteger10 As Integer
|
|
36
|
+
|
|
37
|
+
ELInteger10 = 0
|
|
38
|
+
ELIntegerB = 0
|
|
39
|
+
ELIntegerC = 0
|
|
40
|
+
ELInteger = 0
|
|
41
|
+
|
|
42
|
+
ELIntegerCount6 = 4
|
|
43
|
+
ELIntegerCount5 = 4
|
|
44
|
+
ELIntegerCount4 = 4
|
|
45
|
+
|
|
46
|
+
ELIntegerCount3 = 4
|
|
47
|
+
ELIntegerCount2 = 4
|
|
48
|
+
ELIntegerCount1 = 4
|
|
49
|
+
|
|
50
|
+
Dim ELIntegerCountStringer1 As String
|
|
51
|
+
Dim ELIntegerCountStringer2 As String
|
|
52
|
+
Dim ELIntegerCountStringer3 As String
|
|
53
|
+
Dim ELIntegerCountStringer4 As String
|
|
54
|
+
Dim ELIntegerCountStringer5 As String
|
|
55
|
+
Dim ELIntegerCountStringer6 As String
|
|
56
|
+
|
|
57
|
+
'ブランド抽出処理
|
|
58
|
+
Set interNet2 = CreateObject("Internetexplorer.Application")
|
|
59
|
+
interNet2.Visible = False
|
|
60
|
+
kasan = ".html"
|
|
61
|
+
Sisokuenzan = Search + kasan
|
|
62
|
+
interNet2.navigate "http://www.buyma.com/brand/" & Sisokuenzan
|
|
63
|
+
|
|
64
|
+
Do While interNet2.Busy = True Or interNet2.readyState < READYSTATE_COMPLETE
|
|
65
|
+
DoEvents
|
|
66
|
+
Loop
|
|
67
|
+
|
|
68
|
+
Set HTMLD = interNet2.document
|
|
69
|
+
Set Colect = HTMLD.getElementsByClassName("vmimg_120")
|
|
70
|
+
|
|
71
|
+
'各ブランドのバイヤーTop3展開処理
|
|
72
|
+
For Each EL In Colect
|
|
73
|
+
SPDate = EL.innerHTML
|
|
74
|
+
ELStringer = Mid(SPDate, 95)
|
|
75
|
+
ELInteger = InStr(ELStringer, "l")
|
|
76
|
+
ELStringer2 = Left(ELStringer, ELInteger)
|
|
77
|
+
|
|
78
|
+
'各ブランドのTop3バイヤー取得処理
|
|
79
|
+
Set interNet3 = CreateObject("Internetexplorer.Application")
|
|
80
|
+
interNet3.Visible = False
|
|
81
|
+
interNet3.navigate ELStringer2
|
|
82
|
+
|
|
83
|
+
Do While interNet3.Busy = True Or interNet3.readyState < READYSTATE_COMPLETE
|
|
84
|
+
DoEvents
|
|
85
|
+
Loop
|
|
86
|
+
|
|
87
|
+
Set HTMLD2 = interNet3.document
|
|
88
|
+
Set Colect2 = HTMLD2.getElementsByClassName("profimg_wrap")
|
|
89
|
+
|
|
90
|
+
'各ブランドのTop3バイヤー表示処理
|
|
91
|
+
For Each El2 In Colect2
|
|
92
|
+
SPDate2 = El2.innerHTML
|
|
93
|
+
ELStringer3 = Mid(SPDate2, 14)
|
|
94
|
+
ELInteger2 = InStr(ELStringer3, "http")
|
|
95
|
+
ELInteger4 = ELInteger2
|
|
96
|
+
ELStringer4 = Left(ELStringer3, ELInteger4)
|
|
97
|
+
ELIntegerA = InStr(ELStringer4, "alt") + 5
|
|
98
|
+
ELInteger6 = InStr(ELIntegerA, ELStringer4, """")
|
|
99
|
+
ELInteger8 = ELInteger6 - ELIntegerA
|
|
100
|
+
ELStringer5 = Mid(ELStringer4, ELIntegerA, ELInteger8)
|
|
101
|
+
Next El2
|
|
102
|
+
|
|
103
|
+
'ランキング表示処理
|
|
104
|
+
ELInteger10 = ELInteger10 + 1
|
|
105
|
+
If ELInteger10 = 1 Then
|
|
106
|
+
Range("A1").Value = "ランキング1位:" & ELStringer5
|
|
107
|
+
ElseIf ELInteger10 = 2 Then
|
|
108
|
+
Range("D1").Value = "ランキング2位:" & ELStringer5
|
|
109
|
+
ElseIf ELInteger10 = 3 Then
|
|
110
|
+
Range("G1").Value = "ランキング3位:" & ELStringer5
|
|
111
|
+
End If
|
|
112
|
+
|
|
113
|
+
'バイヤー別売上ランキング取得処理
|
|
114
|
+
ELInteger12 = InStr(ELStringer4, ".html") - 1
|
|
115
|
+
ELStringer13 = Left(ELStringer4, ELInteger12)
|
|
116
|
+
|
|
117
|
+
Set interNet4 = CreateObject("Internetexplorer.Application")
|
|
118
|
+
interNet4.Visible = False
|
|
119
|
+
interNet4.navigate "http://www.buyma.com/" & ELStringer13 + "/sales_1.html"
|
|
120
|
+
|
|
121
|
+
Do While interNet4.Busy = True Or interNet4.readyState < READYSTATE_COMPLETE
|
|
122
|
+
DoEvents
|
|
123
|
+
Loop
|
|
124
|
+
|
|
125
|
+
Set HTMLD3 = interNet4.document
|
|
126
|
+
Set Colect3 = HTMLD3.getElementsByClassName("data_line0")
|
|
127
|
+
Set HTMLD4 = interNet4.document
|
|
128
|
+
Set Colect4 = HTMLD4.getElementsByClassName("data_line1")
|
|
129
|
+
|
|
130
|
+
'デバッキング処理
|
|
131
|
+
For Each ELD In Colect3
|
|
132
|
+
ELStringer15 = ELD.innerHTML
|
|
133
|
+
Debug.Print ELStringer15
|
|
134
|
+
ELStringer17 = Mid(ELStringer15, 168)
|
|
135
|
+
Debug.Print ELInteger17
|
|
136
|
+
ELInteger18 = InStr(ELStringer17, """>")
|
|
137
|
+
Debug.Print ELInteger18
|
|
138
|
+
ELStringer20 = Left(ELStringer17, ELInteger18)
|
|
139
|
+
Debug.Print ELStringer20
|
|
140
|
+
ELInteger100 = Len(ELStringer20)
|
|
141
|
+
ELInteger200 = ELInteger100 - 2
|
|
142
|
+
ELStringer24 = Left(ELStringer20, ELInteger200)
|
|
143
|
+
Debug.Print ELStringer24
|
|
144
|
+
ELInteger2000 = Len(ELStringer24)
|
|
145
|
+
ELInteger4000 = ELInteger2000 - 15
|
|
146
|
+
ELStringer1000 = Right(ELStringer24, ELInteger4000)
|
|
147
|
+
Debug.Print ELStringer1000
|
|
148
|
+
Set interNet5 = CreateObject("Internetexplorer.Application")
|
|
149
|
+
interNet5.Visible = False
|
|
150
|
+
interNet5.navigate "http://www.buyma.com/item/" & ELStringer1000
|
|
151
|
+
Next ELD
|
|
152
|
+
|
|
153
|
+
'商品リスト展開メインルーチン
|
|
154
|
+
ELIntegerB = ELIntegerB + 1
|
|
155
|
+
If ELIntegerB = 1 Then
|
|
156
|
+
For Each El3 In Colect3
|
|
157
|
+
ELIntegerCount1 = ELIntegerCount1 + 1
|
|
158
|
+
ELIntegerCountStringer1 = ELIntegerCount1
|
|
159
|
+
SPDate10 = El3.innerText
|
|
160
|
+
Range("A" & ELIntegerCountStringer1).Value = SPDate10
|
|
161
|
+
Next El3
|
|
162
|
+
|
|
163
|
+
ElseIf ELIntegerB = 2 Then
|
|
164
|
+
For Each El4 In Colect3
|
|
165
|
+
ELIntegerCount2 = ELIntegerCount2 + 1
|
|
166
|
+
ELIntegerCountStringer2 = ELIntegerCount2
|
|
167
|
+
SPDate10 = El4.innerText
|
|
168
|
+
Range("C" & ELIntegerCountStringer2).Value = SPDate10
|
|
169
|
+
Next El4
|
|
170
|
+
|
|
171
|
+
ElseIf ELIntegerB = 3 Then
|
|
172
|
+
For Each El5 In Colect3
|
|
173
|
+
ELIntegerCount3 = ELIntegerCount3 + 1
|
|
174
|
+
ELIntegerCountStringer3 = ELIntegerCount3
|
|
175
|
+
SPDate10 = El5.innerText
|
|
176
|
+
Range("E" & ELIntegerCountStringer3).Value = SPDate10
|
|
177
|
+
Next El5
|
|
178
|
+
End If
|
|
179
|
+
|
|
180
|
+
'商品リスト2展開メインルーチン
|
|
181
|
+
ELIntegerC = ELIntegerC + 1
|
|
182
|
+
If ELIntegerC = 1 Then
|
|
183
|
+
For Each El6 In Colect4
|
|
184
|
+
ELIntegerCount4 = ELIntegerCount4 + 1
|
|
185
|
+
ELIntegerCountStringer4 = ELIntegerCount4
|
|
186
|
+
SPDate11 = El6.innerText
|
|
187
|
+
Range("B" & ELIntegerCountStringer4).Value = SPDate11
|
|
188
|
+
Next El6
|
|
189
|
+
|
|
190
|
+
ElseIf ELIntegerC = 2 Then
|
|
191
|
+
For Each El7 In Colect4
|
|
192
|
+
ELIntegerCount5 = ELIntegerCount5 + 1
|
|
193
|
+
ELIntegerCountStringer5 = ELIntegerCount5
|
|
194
|
+
SPDate11 = El7.innerText
|
|
195
|
+
Range("D" & ELIntegerCountStringer5).Value = SPDate11
|
|
196
|
+
Next El7
|
|
197
|
+
|
|
198
|
+
ElseIf ELIntegerC = 3 Then
|
|
199
|
+
For Each El8 In Colect4
|
|
200
|
+
ELIntegerCount6 = ELIntegerCount6 + 1
|
|
201
|
+
ELIntegerCountStringer6 = ELIntegerCount6
|
|
202
|
+
SPDate11 = El8.innerText
|
|
203
|
+
Range("F" & ELIntegerCountStringer6).Value = SPDate11
|
|
204
|
+
Next El8
|
|
205
|
+
End If
|
|
206
|
+
|
|
207
|
+
'初期化処理
|
|
6
208
|
ELIntegerD = ELIntegerD + 1
|
|
7
209
|
If ELIntegerD = 3 Then
|
|
8
210
|
|
|
9
|
-
Dim ObjectShell As Object
|
|
10
|
-
Dim QuiteObject As Object
|
|
11
|
-
|
|
211
|
+
ELInteger10 = 0
|
|
212
|
+
ELIntegerB = 0
|
|
213
|
+
ELIntegerC = 0
|
|
214
|
+
ELIntegerD = 0
|
|
12
215
|
|
|
216
|
+
'Dim ObjectShell As Object
|
|
217
|
+
'Dim QuiteObject As Object
|
|
218
|
+
'Dim CountInteger As Integer
|
|
219
|
+
|
|
13
|
-
Set ObjectShell = CreateObject("Shell.Application")
|
|
220
|
+
'Set ObjectShell = CreateObject("Shell.Application")
|
|
14
|
-
For CountInteger = ObjectShell.Windows.Count To 1 Step -1
|
|
221
|
+
'For CountInteger = ObjectShell.Windows.Count To 1 Step -1
|
|
15
|
-
Set QuiteObject = ObjectShell.Windows(CountInteger - 1)
|
|
222
|
+
'Set QuiteObject = ObjectShell.Windows(CountInteger - 1)
|
|
16
|
-
If Right(UCase(QuiteObject.FullName), 12) = "IEXPLORE.EXE" Then
|
|
223
|
+
'If Right(UCase(QuiteObject.FullName), 12) = "IEXPLORE.EXE" Then
|
|
17
|
-
QuiteObject.Quit
|
|
224
|
+
'QuiteObject.Quit
|
|
225
|
+
'End If
|
|
226
|
+
'Next
|
|
227
|
+
|
|
228
|
+
Dim SHE As Object
|
|
229
|
+
Dim QIT As Object
|
|
230
|
+
Dim CIG As Integer
|
|
231
|
+
|
|
232
|
+
Set SHE = CreateObject("Shell.Application")
|
|
233
|
+
For CIG = SHE.Windows.Count To 1 Step -1
|
|
234
|
+
Set QIT = SHE.Windows(CIG - 1)
|
|
235
|
+
If QIT = "iexplore.exe" Then
|
|
236
|
+
QIT.Quit
|
|
18
237
|
End If
|
|
19
238
|
Next
|
|
20
239
|
End If
|
|
21
240
|
Next EL
|
|
22
241
|
End Sub
|
|
23
242
|
|
|
243
|
+
'スクレイピングスタート
|
|
244
|
+
Private Sub CommandButton2_Click()
|
|
245
|
+
End Sub
|
|
246
|
+
|
|
247
|
+
'バイヤー抽出
|
|
248
|
+
Private Sub CommandButton3_Click()
|
|
249
|
+
End Sub
|
|
250
|
+
|
|
251
|
+
Private Sub TextBox1_Change()
|
|
252
|
+
Search = TextBox1.Value
|
|
253
|
+
End Sub
|
|
254
|
+
|
|
255
|
+
Private Sub UserForm_Click()
|
|
256
|
+
End Sub
|
|
257
|
+
|
|
24
258
|
```
|
|
25
259
|
ここまでです。
|
|
26
260
|
|