圖1.程式碼流程
續前篇,維護好股票代碼後,做網路爬蟲與分析。
如何分析請參考前篇內容,至於資料怎整理的???
筆者是先想好呈現方式後再開始撰寫程式碼。
筆者是這樣呈現的,單純參考:
圖2.整理呈現
做一個Activex命令按鈕,並使工作頁命名為"營收盈餘"與"營收彙整"等兩頁,然後在按鈕內撰寫以下內容:
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Private Sub CommandButton1_Click() | |
Application.DisplayAlerts = False '關閉警告 | |
i = 4 '設定儲存格起始值 | |
While Sheets("營收彙整").Range("A" & i) <> "" '檢查儲存格有無資料 | |
Sheets("營收盈餘").Cells.Clear '清楚資料 | |
Sheets("營收盈餘").Activate '啟用工作頁 | |
Call 新版營收("http://xxxxxxxxxxxxxxxxxxxx_" & Sheets("營收彙整").Range("A" & i) & ".djhtm") '使用網路爬蟲的副程式 ,網址請參考卷商歐,筆者不方便提供。 | |
Set Rng = ActiveSheet.UsedRange.Find(What:="無資料") '透過find方法判斷資料有無 | |
If Rng Is Nothing Then | |
Set Rng = ActiveSheet.UsedRange.Find(What:="年/月") '透過find方法找字串位置 | |
If Rng Is Nothing Then | |
S = 0 | |
Sheets("營收彙整").Range("B" & i) = "?" '查無資料以問號註記 | |
Else | |
S = Rng.Row + 1 'Rng.Row為行資料,+1取得最新資料位置 | |
Sheets("營收彙整").Range("B" & i) = Sheets("營收盈餘").Range("b" & S) | |
'6個月 | |
Sheets("營收盈餘").Range("M1").Formula = "=IF(SUMPRODUCT(--(F" & S & ":F" & S + 5 & ">=0))=6,TRUE,FALSE)" '6個月為正 | |
Sheets("營收盈餘").Range("M1").Calculate | |
Sheets("營收彙整").Range("C" & i) = Sheets("營收盈餘").Range("M1") | |
'3個月 | |
Sheets("營收盈餘").Range("M1").Formula = "=IF(SUMPRODUCT(--(F" & S & ":F" & S + 2 & ">=0))=3,TRUE,FALSE)" '3個月為正 | |
Sheets("營收盈餘").Range("M1").Calculate | |
Sheets("營收彙整").Range("D" & i) = Sheets("營收盈餘").Range("M1") | |
'1個月 | |
Sheets("營收盈餘").Range("M1").Formula = "=IF(SUMPRODUCT(--(F" & S & ">=0))=1,TRUE,FALSE)" '1個月為正 | |
Sheets("營收盈餘").Range("M1").Calculate | |
Sheets("營收彙整").Range("E" & i) = Sheets("營收盈餘").Range("M1") | |
If Sheets("營收盈餘").Range("F" & S) <> "" Then '整理資料 | |
Sheets("營收彙整").Range("F" & i) = Sheets("營收盈餘").Range("F" & S) | |
Sheets("營收彙整").Range("G" & i) = Sheets("營收盈餘").Range("H" & S) '抓累計年增率 | |
Else | |
Sheets("營收彙整").Range("F" & i) = "空白" | |
End If | |
End If | |
Else | |
S = 0 | |
設定取消廣告分潤 | |
Sheets("營收彙整").Range("B" & i) = "?" | |
End If | |
Sheets("營收彙整").Activate | |
i = i + 1 | |
Wend | |
Sheets("營收彙整").Activate | |
End Sub | |
Sub 新版營收(url) | |
temp_time="" | |
Dim web, webdata | |
Set web = CreateObject("Microsoft.XMLHTTP") | |
web.Open "get", url, False | |
web.send | |
Do Until web.readyState = 4 | |
DoEvents | |
Application.Wait DateAdd("s", 0.3, Now) '暫停0.3秒 | |
If temp_time = "" Then | |
temp_time = Now() | |
Else | |
temp = DateDiff("s", temp_time, Now()) | |
If temp > 1 Then '設定防呆機制 | |
MsgBox "ERROR" | |
Exit SUB | |
End If | |
End If | |
Loop | |
webdata = Split(web.responseText, vbLf) | |
B = Filter(webdata, "查無") | |
bv = Filter(webdata, "t3n1") | |
If UBound(bv) > 0 Then | |
ReDim S_DATA(UBound(bv), 6) As Variant | |
End If | |
A = 0 | |
If UBound(B) < 0 Then | |
For i = 0 To UBound(webdata) Step 1 | |
If InStr(webdata(i), "t3n1") > 0 Then 'And InStr(webdata(i), "t3r1") > 0 | |
item1 = LTrim(webdata(i)) | |
If i = 128 Then | |
i = i | |
End If | |
item1 = Split(item1, "/") | |
S_DATA(A, 0) = (Right(item1(0), 3)) & "/" & Left(item1(1), 2) | |
For S = 2 To UBound(item1) Step 1 | |
n2 = Split(item1(S), "td><td class=") | |
n3 = 1 | |
If UBound(n2) > 0 Then | |
x = Len(n2(1)) | |
For V = 0 To x Step 1 | |
A1 = Mid(n2(1), n3, 1) | |
n3 = n3 + 1 | |
If A1 = ">" Then | |
S_DATA(A, S - 1) = Mid(n2(1), n3, x - n3) | |
Exit For | |
End If | |
Next V | |
End If | |
Next S | |
A = A + 1 | |
End If | |
Next i | |
Sheets("營收盈餘").Range("b8:h8") = Array("年/月", "合併營收", "月增率", "去年同期", "年增率", "累計營收", "年增率") | |
If IsArray(S_DATA) = True Then | |
If S_DATA(0, 1) <> "" Then | |
Sheets("營收盈餘").Range("b9:h" & A) = S_DATA | |
End If | |
End If | |
End If | |
End Sub |
測試:
筆者以1101、1102、1301、2002做測試下:
image
圖3.測試結果
完成!!!
如果要在更豐富一點,也可以透過儲存格設定方式,讓年增率部分以百分比與顏色方式呈現。
在CommandButton1_Click增加:
Sheets("營收彙整").Range("f" & i & ":g" & i).NumberFormatLocal = "0.00%;[紅色](0.00%)"
就會長類似這樣:
image
圖4.美工後結果
大致上,先到這;整理美觀部分也來單獨整理一篇vba好了。
缺點整理:
時間性:如果要一次性抓上千筆資料,要花一點時間,畢竟這是單執行緒的程式,雖然比手動快多了,筆者自己的電腦,進行測試大約要13~15分鐘吧。
資料保存:筆者沒有寫自動存檔功能,資料都爬回來了,不保存下來總覺得有點可惜,應該弄個資料庫加強版才對厚。
昨晚想到沒寫怎應用:下
沒有留言:
張貼留言