2020年12月7日 星期一

VBA 營收資料分析(二)

參閱本篇分享文,也請尊重網路資源,請勿濫用網路爬蟲相關軟體技術歐。



圖1.程式碼流程

續前篇,維護好股票代碼後,做網路爬蟲與分析。

如何分析請參考前篇內容,至於資料怎整理的???

筆者是先想好呈現方式後再開始撰寫程式碼。

筆者是這樣呈現的,單純參考:



圖2.整理呈現

做一個Activex命令按鈕,並使工作頁命名為"營收盈餘"與"營收彙整"等兩頁,然後在按鈕內撰寫以下內容:


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分鐘吧。

資料保存:筆者沒有寫自動存檔功能,資料都爬回來了,不保存下來總覺得有點可惜,應該弄個資料庫加強版才對厚。

昨晚想到沒寫怎應用:下

沒有留言:

張貼留言

指數變化(2025.03.28)

 指數變化(2025.03.28) 上周焦點: 美國消費者信心指數 3/25 92.9 美國耐久財訂單月增率 3/26 1.4 PCE 月增 0.4 年增 2.8 (不多阿,最高還有5.5ㄝ)   本周愛看: 美國非農業就業人數變化 美國ISM製造業採購經理人指數 美國芝加哥FE...