Excel Vba 營收資料分析 Sumproduct+vba (二) 補CODE－a200271071的部落格

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

圖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

爬蟲副程式暫時拿掉。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