VBA：營收資料分析(三) Sumproduct+vba

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

 筆者剛接觸股票時，頭一件是就是掌握營收狀態，營收狀態最重要得是"營收年增率"，但又不可能一間公司一間公司看，所以開始思考寫VBA自動分析。

分析的方式很簡單，就是最近一個月不得為負數、過去3個月不得為負數與過去6個月不得為負數，這樣得概念來做分析。

筆者直接利用EXCEL內建函數SUMPRODUCT來處理這部份分析。

先來測試一下函數。

以下資料為例：

​​​在H1儲存格，寫入=IF(SUMPRODUCT(--(F9:F14>=0))=6,TRUE,FALSE) 函數，

來判斷是否6個月得"年增率"都大於0，成立則顯示TRUE反之為 FALSE，以此類推。

H2：=IF(SUMPRODUCT(--(F9:F11>=0))=3,TRUE,FALSE)、判斷3個月

H3：=IF(SUMPRODUCT(--(F9>=0))=1,TRUE,FALSE)，判斷最近1個月

結果：皆為FALSE，應用SUMPRODUCT函數沒問題了。

​

接下來思考整體流程該怎做。

​​

​

​圖1.程式碼流程

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

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

筆者是這樣呈現的，單純參考：

​

圖2.整理呈現

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

	'COPYRIGHT BY dropit.liu.
	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
	爬蟲副程式暫時拿掉。4.23重補上
	Sub 新版營收(url)
	Dim web, webdata
	Set web = CreateObject("Microsoft.XMLHTTP")
	web.Open "get", url, False
	web.send
	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做測試下：

​

圖3.測試結果