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

view raw 營收資料分析(二) .VBA hosted with ❤ by GitHub

測試：

筆者以1101、1102、1301、2002做測試下：

image

圖3.測試結果

完成!!!

如果要在更豐富一點，也可以透過儲存格設定方式，讓年增率部分以百分比與顏色方式呈現。

在CommandButton1_Click增加：

Sheets("營收彙整").Range("f" & i & ":g" & i).NumberFormatLocal = "0.00%;[紅色](0.00%)"

就會長類似這樣：

image

圖4.美工後結果

大致上，先到這；整理美觀部分也來單獨整理一篇vba好了。

缺點整理：

時間性：如果要一次性抓上千筆資料，要花一點時間，畢竟這是單執行緒的程式，雖然比手動快多了，筆者自己的電腦，進行測試大約要13~15分鐘吧。

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

昨晚想到沒寫怎應用：下