2020年12月28日 星期一

VBA:AutoFilter應用:找特定時間區間,股價最高與最低值(YAHOO FINANCE CSV為例)

 RANGE有相當多的屬性跟方法,AutoFilter即為RANGE的方法之一,MSDN查詢結果,小小編由YAHOO FINANCE下載了某間公司的過去歷史股價,合計5200多筆收盤價資料,以此案例來實際操作一。範例下載

 P.S範例資料有略為簡化。

如果你經常在用YAHOO FINANCE下載資料來用,可以看看怎操作😀

至於批次找出各公司的最高最低價,有空在單獨寫一篇。

一、目的:找出該公司每一年最高與最低股價。

圖1.原始資料

二、IPO發想與評估:

每一年,所以有期間限制、最高最低價內建函數可以解決、是否要使用陣列的方式堆壘資料

2.1 IPO拆解步驟:

A.資料來源:在A到F行,A行為日期,B到E行為股價資料。

         B.怎處理: 

1.觀察資料與問題:

(1)資料為連續的,沒有空白,有完整日期標示可以免除資料前處理。

(2)現況資料有幾年?怎知道是那一年開始的?

(3)找出最大與最小分別可以透過MAX與MIN等內建函數完成。

(4)透過內建函數MAX與MIN,但對應的範圍怎設定才能是特定期間? 

2.滿足問題:

(1)有幾年這部分,因為資料是連續的,可以透過取的最後一筆資料跟第一筆資料來判斷需要執行幾年的期間,來設計迴圈。

(2)內建函數範圍設定這部分,回想到VBA:Cells.SpecialCells 簡單應用+ 資料排序一文,透過設定為xlCellTypeConstants方式來取的位置即可解決。

C.輸出 :

把年份找出來後,新增一頁工作表名為OUT,做各年份最高最低股價結果顯示與儲存用。 

2.2 評估:

每一年,所以有期間限制:OK

最高最低價內建函數可以解決:OK

是否要使用陣列的方式堆壘資料:股價不用天天整理最高最低,所以免用陣列。

三、動作寫:

     AutoFilter 簡單說明:

 Sheets("還原股價").Range("$A$1:$f$" & END_ROW).AutoFilter Field:=1, Criteria1:= _

           ">=" & year_begin & "/1/1", Operator:=xlAnd, Criteria2:="<=" & year_begin & "/12/31" 

Field:設定篩選的條件是第幾行。

Criteria1、Criteria1:因為是區間,所以要設定2個條件。

Operator:篩選類型設定,因為有兩個條件所以設為xlAnd。

year_begin:是透過迴圈控制的篩選變數,配合 "/1/1"與"/12/31" 組合成年頭與年末的篩選條件。

先作一個ACTIVEX按鈕插入以下VBA:

Private Sub CommandButton1_Click()
Sheets("OUT").Cells.Clear
Sheets("還原股價").Activate
END_ROW = Sheets("還原股價").Range("a" & 10000).End(xlUp).Row
end_year = Split(Sheets("還原股價").Range("a" & END_ROW).Value, "/")
NOW_YEAR = Split(Sheets("還原股價").Range("a" & 2).Value, "/")
NOW_YEAR = NOW_YEAR(0)
fh = 2 '開始位置
Sheets("OUT").Range("A1:C1") = Array("股價(年)", "最高", "最低")
For year_begin = NOW_YEAR To end_year(0) Step -1
Sheets("還原股價").Range("$A$1:$f$" & END_ROW).AutoFilter Field:=1, Criteria1:= _
">=" & year_begin & "/1/1", Operator:=xlAnd, Criteria2:="<=" & year_begin & "/12/31"
Set A = ActiveSheet.Range("b:e").SpecialCells(xlCellTypeVisible)
Max = Application.Max(ActiveSheet.Range(A.Address))
Min = Application.Min(ActiveSheet.Range(A.Address))
Sheets("OUT").Range("A" & fh) = year_begin
Sheets("OUT").Range("B" & fh) = Max
Sheets("OUT").Range("C" & fh) = Min
fh = fh + 1
Next year_begin
Sheets("還原股價").AutoFilterMode = False
End Sub
view raw gistfile1.txt hosted with ❤ by GitHub

圖2.按鈕一測試結果


小小編突發奇想,想要知道股價日期,追加修改了一下:

在作一個ACTIVEX按鈕插入以下VBA: 

Private Sub CommandButton2_Click()
Sheets("OUT").Cells.Clear
Sheets("還原股價").Activate
END_ROW = Sheets("還原股價").Range("a" & 10000).End(xlUp).Row
end_year = Split(Sheets("還原股價").Range("a" & END_ROW).Value, "/")
NOW_YEAR = Split(Sheets("還原股價").Range("a" & 2).Value, "/")
NOW_YEAR = NOW_YEAR(0)
fh = 2 '開始位置
Sheets("OUT").Range("A1:E1") = Array("股價(年)", "最高", "最低", "最高日期", "最低日期")
For year_begin = NOW_YEAR To end_year(0) Step -1
ActiveSheet.Range("$A$1:$f$" & END_ROW).AutoFilter Field:=1, Criteria1:= _
">=" & year_begin & "/1/1", Operator:=xlAnd, Criteria2:="<=" & year_begin & "/12/31"
Set A = ActiveSheet.Range("b:e").SpecialCells(xlCellTypeVisible)
Max = Application.Max(ActiveSheet.Range(A.Address))
Min = Application.Min(ActiveSheet.Range(A.Address))
Sheets("OUT").Range("A" & fh) = year_begin
Sheets("OUT").Range("B" & fh) = Max
Sheets("OUT").Range("C" & fh) = Min
Set A_FIND = A.Find(WHAT:=Max)
If A_FIND Is Nothing Then
Else
Sheets("OUT").Range("D" & fh) = ActiveSheet.Range("A" & A_FIND.Row).Value
End If
Set A_FIND = A.Find(WHAT:=Min)
If A_FIND Is Nothing Then
Else
Sheets("OUT").Range("E" & fh) = ActiveSheet.Range("A" & A_FIND.Row).Value
End If
fh = fh + 1
Next year_begin
Sheets("還原股價").AutoFilterMode = False
End Sub
view raw gistfile1.txt hosted with ❤ by GitHub

圖3.按鈕二測試結果


2020年12月27日 星期日

IPO:寫VBA時的基本流程

何謂IPO參閱


小編滿常寫VBA的,不論是外包或是心血來潮寫自己東西的時候。
曾有個學生問:"你怎馬上知道這問題怎做?"、"你怎思考的?"
這問題小小編的我也想了很久,回歸到基本原則就是流程化拆解,小編本科是念I.E的,寫程式完全是半路出家,單純自我實現,然後不知不覺越寫越多,在這自我實現中,以流程化拆解,來觀察問題,進而解決問題小小編自覺是最基本的原則。

以VBA來說,不外乎資料來源、怎處理、預計結果等3原則來拆解一個VBA的問題。
小小編簡單說明一下,來引導思考:

1.資料來源:今天要整理一份資料,資料在那一頁工作表?在多少頁工作表?在多少儲存格中?在多少檔案中?在多少電腦的分享資料夾中;這樣來想像一下不管是整理資料,還是要做簡單計算,"資料來源"在那,怎掌握怎取得,是第一個思考點。

2.怎處理:有資料了,怎處理!然後可以變成預期的結果,最好的情況是EXCEL內建函數就可以算最好了,若不是則要自己寫函數或是公式來計算;或是你的處理是要把相同資料整理在一起;講白話一點,就是你打算對資料做那些加更工拉,這加工方式能否以EXCEL內建功能完成,不然就要自己想方法。

3.預計結果:
這邊說的預計結果跟怎處理,似乎有點類似,但小小編要說的是預計結果,分成2塊;3.1資料處理完輸出為下一個處理的預計結果,直到所有處理都完成才結束。3.2有指定表單做結果輸出的部分,需要把預計結果寫到表單上;或是前者則與2.怎處理有關聯。反之就是做最後的表單輸出。


為何要學VBA?學寫程式的差異在那?

一、先來簡單聊聊VBA是啥?

VBA是微軟在OFFICE產品線中,內建的一個巨集的功能,透過巨集功能錄製的操作,則是以VBA方式記錄成巨集,讓使用者可以實現單一作業重複,但錄製功能卻十分十分十分地受限;更早之前在VB的時代中,微軟把物件寫好提供給各開發者,能夠直接使用,讓開發人員能快速完成視窗工具的開發,但也因為這樣開發也常常因為物件而受限(能力超強的軟體工程師會自己寫物件的除外XD);回到VBA,雖然錄製功能十分受限,但其實VBA很早就內建在OFFICE的軟體中,不論WORD、EXCEL、POWERPOINT、OUTLOOK,直到最新的OFFICE都還是有他的影子歐,那VBA到底是????

整理一下:

簡單來說就是Visual basic(簡稱VB)的延伸語言,在最大差異是VB的程式語言的產出,通常有經過"編譯"所以可以單獨變成安裝程式,並可安裝於WINDOWS平台中,但VBA僅能依附在OFFICE的檔案中(如*.xlsm、*.doc)。但!寫程式的架構與邏輯可一點也沒特別被簡化歐!!!

二、為何要學VBA?

首先我必須說,這問題跟,"為何要學錄製巨集是完全不同層次的問題",要先區分開來;要透過VB或C#畫出一張超美且有標題、例圖的折線圖或直方圖或任何圖形,簡直是要累死工程師生命,不不不,做更正,應該說如果有更簡便的資料整理工具(先不管你OFFICE是教育版、刷卡買的、還是點BT得到的),OFFICE工具應該算是最普羅大眾且算接受度最高的整理資料工具吧(當然微軟後面還有出像是POWER BI的工具) ,且也開始有一部分主流ERP廠商,甚至將VBS語法內建,透過匯出的資料集中,透過命名為VBS檔案方式,讓使用者透過單機去自行生成資料,來降低erp系統的負載,也更有一部分廠家如XXXCAD,也有內建VBA搂;有點離題了,小小編在這將VBA學習,區為幾個淺在問題面向來剖析:

1.在資料作業整理中,具備高度作業重複的作業的需要

2.無法從0開始學習也無這方面基礎,但又有大量資料運算分析的需要。

備註:很多人都是透過EXCEL來分析製程(Ca、Cpk、Spc)、整理股票或對帳等的應用,小小編是認為都算大量資料。

3.老闆不願意花錢找人寫客製軟體或雇用相關專業人員(這是出社會的感觸)

以上3點具備任何一點,小小編建議,在不讓自己雙手累死,以及眼睛度數逐年增加的考量下,若學習意志足夠,不妨花點時間來學習,既可以幫助自己工作效率提升學到某程度真有興趣,其實整理資料也可以是打在另外一扇門經營自己的方向歐。

p.s具備以上3點任2點很多做不下去的人,更多人選寫履歷 xd

三、最後:學寫程式的差異在那?

小小編以幾個切入點分享:

1.嚴謹度:對初學的小白來說,不需要像是C這類語言,變數都要宣告才能用或是要做那些運算要掛載啥元件的!免;VBA這部分嚴謹度不高,但反過來想,你要先宣告變數先掛載元件,也是可以的歐;所以相對來說比較算比較寬鬆拉,但這也是缺點,就不知不覺變數越用越多了,消耗記憶體跟拖慢運算速度搂(但絕對比手快)。

2.輔助:OFFICE內建相當多的功能,這些功能,全都可以透過vba直接使用,例如算迴歸方程式、算加總....做篩選等,實在太多,但你要用程式語言做?花2~3萬元去學python搞不好你連迴圈都還搞不清楚就下課了(強調沒有看不起人歐,因為python是免費的開發軟件;更白話的是,沒人分享案例或功能,你就要都自己寫自己要的功能)。

3.資源:因為內建在OFFICE內,這表示你可以透過微軟線上(MSDN),查到一堆資料,更甚至如果學習過程中對物件熟悉了,可以透過物件使直接查詢網路資源,找類似案例應用做學習。


VBA:做資料排序,文字+數字(非SORT的方法)

這是狀況題!!!

不知道大家有無遇到一個狀況,就是單純文字或是單純數字排序時,都沒問題;單純文字或單純數字排序時,大到小小到大,很簡單,但當文字跟數字資料混再一起時,例如P1、P2、P3、P4、P5、P10, 這樣時透過EXCEL VBA用SORT方法排序時會變成如圖1.。

圖1.

如題,強調,不是使用SORT方法簡單的排序歐;這是一個相同文字的例子,或許有很多網友會想加一個0就好啦。

恕不知道現實工作中,加一個0,需要多少長官同意才能改(哭哭),因為很可能料號要重編,影響範疇很大。

小編透過這個例子分享,小編處理的小想法。

首先處理資料分為前處理、拆解、在重組。
前處理:處理字串。
拆解:拆解字串,單獨分割出數字。
重組:因為本案例數字跟文字有關連性,算好處理,可以直接重組特定文字+排序後數字。
圖2.


問題複雜版:
當同時存有多組文字時,也可以使用如上思維。
    
圖3.

問題複雜版+指定排序:這部分筆者主要是多陣列控制來完成多字元組合與分割。

圖4.





財務面簡單整理(本益比、營業利益率、稅後淨利YOY.......)

單純為自己VBA練習演算法而已強調僅供參考。
小編無聊寫了個演算法,去爬資料後,透過多條件篩選結果如下:
1.篩選條件彙整:


圖1.

說明:反黃每一層往下一層就是多增加一個篩選條件資料,同一層有2個則表示各單獨條件篩選出來的結果。
2.股價走勢:
圖2.股本變化率<=0

說明:此為綜合7個篩選條件後14檔股票的股價走勢。
成長百分比說明:10/15,10為僅10家股價走揚(簡單肉眼判斷)
P.S每一層篩選都跑股價走勢圖很累,請原諒。






2020年12月22日 星期二

VBA:無聊玩財務分析進階篩選V2 (增加營業利益率)

資料範圍:2020.Q3與2020.11月份營收。

設計篩選資料有:

"稅後淨利率、稅後淨利(成長/衰退)、稅後淨利YOY(成長/衰退)、存貨周轉率(成長/衰退)、營收年增率追綜、累積營收、營業利益率、營業利益率成長、營業利益率成長yoy、日乖離率、月乖離率、季乖離率、年乖離率"

 如題,載點


圖1.

操作如下:
單一條件:

例如:輸入股號:2610

點選"執行篩選(1)"後,如圖2

圖2.
多條間:

例如:如圖3設定。
圖3.

點選"執行篩選(1)"後,如圖4.

圖4.

VBA:Cells.SpecialCells 簡單應用+ 資料排序

有常在用進階篩選的我,要抓篩選後的資料,剛開始學習時,顯示篩選後的藍色區域(參圖1.)的可視範圍,一時半刻不知道該怎樣抓,後來再摸索後發現Cells有一個屬性SpecialCells,透過SpecialCells搜尋MSDN就找到答案了


圖1.篩選後

如圖1.紅框,篩選後字體會反藍色,但是一般抓資料的方式,卻無法直接抓取篩選後的資料。
這時候我們就要來利用一下Cells.SpecialCells的屬性;這個屬性有一個設定,為xlCellTypeVisible。

基本語法: SET a=ActiveSheet.Cells.SpecialCells(xlCellTypeVisible), 用宣告的方式來設置,必免記憶體爆了,要注意。

取得位置:上面宣告完了,透過即時運算就a.address取得位置。(如圖2)


圖2.區域變數與即時運算內容


簡單操作大概以上。
最近在某版刊到一個應用的例子。
圖3.案例(資料亂貼的狀態)
我借這個例子變化一下ActiveSheet.Cells.SpecialCells+迴圈+排序就搞定了。
新增一個ActiveX按鈕,將隨機資料貼在工作表1,並確認工作簿有工作表2,貼上以下CODE後,點選執行,再去看工作表2(如圖4),完工。
圖4.結果(執行後)
vba code參如下:(VBA設定教學),下載

Private Sub CommandButton1_Click()
Set a = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants) '這邊是用常數設定(xlCellTypeConstants)取得資料非用可視部分(xlCellTypeConstants)
Total = "" '資料堆壘用
For Each a_out In a '迴圈堆壘資料
If Total = "" Then
Total = a_out.Value
Else
Total = Total & "@" & a_out.Value
End If
Next
Sheets("工作表2").Range("a1:" & "a" & a.Count) = WorksheetFunction.Transpose(Split(Total, "@")) '寫入上資料
'排序資料
Sheets("工作表2").Range("a1:" & "a" & a.Count).Sort Key1:=Sheets("工作表2").Range("a1:" & "a" & a.Count), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlStroke, DataOption1:=xlSortNormal
End Sub
view raw gistfile1.txt hosted with ❤ by GitHub

2020年12月21日 星期一

VBA:Range.formula 乖離率

 小編前段時間有機會接觸這個,剛好配合formula做一篇應用簡單分享文。

乖離率:

公式:(目前價-移動平均價)/移動平均價

目前價:可以是收盤價、或是盤中的既有成交價。

移動平均:這部分可以用月(20天)、季(60天)跟年(240天)做計算。

以技嘉為例:

圖1.
當透過軟體計算出20天、60天與240天移動平均後,透過公式(Range.formula)做公式維護。
撰寫語法:

Sheets("工作表1").Cells(I, 2).Formula = "=(F" & I & "-G" & I & ")/" & "G" & I '月乖離率

其中I為控制第幾列儲存格用。

圖2.
如圖2.所示,寫入的公式就會長的像這樣。
當然!為了計算乖離率時,這中間原始資料怎來其實這又是另外的課題了,本篇主要是分享Range.formula的操作簡單分享。




 


2020年12月20日 星期日

VBA:啟用 預設計算、畫面更新、事件提醒、顯示狀態列( Application.ScreenUpdating .......)

  啟用

  Application.ScreenUpdating = True

  Application.DisplayStatusBar = True

  Application.Calculation = xlCalculationAutomatic '(自動)

  Application.EnableEvents = True


關閉:

  Application.ScreenUpdating = False

  Application.DisplayStatusBar = False

  Application.Calculation = xlCalculationManual '(手動)

  Application.EnableEvents = False

VBA:行比較重複時反黃

 自己用的一個小工具:載點

使用方法:

圖1.

VBA設定教學

按鈕1:B行重複反黃(圖1)

1.A行為原始資料,B行貼上要被比較的資料。

2.點選按鈕。

3.反黃表示已重複。

Private Sub CommandButton1_Click()
X1 = Application.CountA(Sheets("SHEET1").Range("A:A"))
X2 = Application.CountA(Sheets("SHEET1").Range("B:B"))
For I = 1 To X1 Step 1
For J = 1 To X2 Step 1
If Val(Sheets("SHEET1").Range("A" & I)) = Val(Sheets("SHEET1").Range("B" & J)) Then
Sheets("SHEET1").Range("B" & J).Interior.Color = QBColor(14)
End If
Next J
Next I
End Sub
view raw gistfile1.txt hosted with ❤ by GitHub

圖2.

按鈕2:(參圖2.)
操作與按鈕1類似。
主要差別是關鍵字比對,當a行的儲存格含有b儲存格的文字時,則b儲存格反黃表示。
Private Sub CommandButton2_Click()
X1 = Application.CountA(Sheets("SHEET1").Range("A:A"))
X2 = Application.CountA(Sheets("SHEET1").Range("B:B"))
For I = 1 To X1 Step 1
For J = 1 To X2 Step 1
If InStr(Sheets("SHEET1").Range("A" & I), Sheets("SHEET1").Range("B" & J)) > 0 Then
Sheets("SHEET1").Range("B" & J).Interior.Color = QBColor(14)
End If
Next J
Next I
End Sub

2020年12月15日 星期二

VBA:無聊玩財務分析進階篩選

 

圖1.
1.篩選:在第2列輸入資料後,點選篩選,即完成操作。

EX1:在B2J輸入 >10

圖2.

 

2.復原:取消篩選

其他雜記,真的無聊,隨便整理,有空在寫更新包


2020年12月13日 星期日

概念股更新檔案載點3/31

3/31更新檔案~~不定期晚上做更新。

程式與教學可參考:概念股更新教學(ㄧ)

自選股教學可參考:概念股更新教學(二)


概念股更新教學(二)

 如果有自己的選股組合,概念股的工作表中,點選a行新增一行,然後打上表頭,如王大強選股;然後輸入股號,如1101、1102;參考圖1.這樣,存檔後關閉檔案再重開。


圖1.
參圖2.存檔後再重開,就會出現自己的選股了。
圖2.
簡易操作說明。




概念股更新教學(ㄧ)

備註說明:此版為部落格載點,與FB版友載點不同歐。



圖1.

概念股方式:點選下拉式選單>點選load 完成

手動輸入方式:手動輸入股號>點選load 完成

更新資料庫:點選後如下圖2.,點選updata xxxxxxx後做新。

圖2.



 

2020年12月8日 星期二

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函數沒問題了。

image

接下來思考整體流程該怎做:下一篇

VBA:西元年與民國年的互動

 RANGE.NumberFormatLocal 這個屬性可以做時間資料格式設定,若沒有使用NumberFormatLocal 屬性,也可以直接透過FORMAT函數,直接針對資料做設定;EX:FORMAT(NOW(),"YYYY/MM/DD")

小編簡單作兩個按鈕一個是切換年月日,另外一個是切換年月日時分。


圖1.
圖2.
Private Sub CommandButton1_Click()
ActiveSheet.Range("B2").NumberFormatLocal = "EE/MM/DD"
ActiveSheet.Range("B3").NumberFormatLocal = "YYYY/MM/DD"
End Sub
Private Sub CommandButton2_Click()
ActiveSheet.Range("B2").NumberFormatLocal = "YYY/MM/DD HH:MM"
ActiveSheet.Range("B3").NumberFormatLocal = "YYYY/MM/DD HH:MM"
End Sub

VBA:資料拆解少不了的SPLIT 函數

這算是滿常用到的函數,做簡單分享:

 SPLIT,資料分割教學:

一、兩個小例子:

日期:109/12/08,透過B2=SPLIT("109/12/08","/"),分割出來的陣列長這樣。

圖1.

關鍵字:DATA:2020/12/08,透過B3=SPLIT("DATA:2020/12/08","DATA:"),分割出來的陣列長這樣

圖2.
分割完出來的資料就可以重新"再加工"做任何編輯了,例如B2(0)為存放年的資料,加上1911就等於西元年了,諸如此類的資料整理。

二、延伸:

若要避免錯誤的用法可以參考組合INSTR函數
例如 :B2="1091208"
IF INSTR(B2,"/")>0 THNE
        B2=SPLIT(B2,"/")
END IF

WHY?WHY?WHY?
因為分割資料時,當未含有指定分割字元時,以B2=SPLIT("1091208","/")與B3=SPLIT("2020/12/08","DATA:")為例則變成這樣:
圖3.
三、再延伸一下:VBA 營收資料分析(二)
當中有一行是處理WEB的回傳結果。
     webdata = Split(web.responseText, vbLf)
分割前,透過即時運算視窗大概是這樣內容:
    
圖4.
分割後,如圖5.在區域變數視窗中,以陣列方式呈現,就可以做很多有趣的處理。

圖5.
以上簡單分享與參考。







2020年12月7日 星期一

VBA:SUMPRODUCT 的美與好

 不知道大家有無處理大量資料的痛,尤其是使用SUMPRODUCT的時候,當有很多儲存格都使用時,開始維護新資料就會有明顯卡頓,小編簡單舉例自己同事,維護的一份簡單進銷存資料從剛開始的1000筆成長到目前的8萬多筆,然後有80個SUMPRODUCT,等於每打一筆資料EXCEL要重新計算64萬次(我可愛的同事都等到要砸鍋了),當然,這部分也是可以透過關閉EXCEL內部的自動計算功能,來避免這個問題發生,但關了經常忘了在重新打開~~這又是另外一個問題了。

先來簡單幫SUMPRODUCT做介紹,使用前若是可以,可以針對資料所在行別,透過"名稱管理員"或是"定義名稱"做定義,這樣就省去每次資料有異動拉儲存格的動作。

接著開始說明SUMPRODUCT;

主要語法結構大致上是這樣:

SUMPRODUCT(資料1=判斷1,資料2=判斷2,資料N=判斷N),

多條件時,透過*號將條件串在一起(資料1=判斷1)*(資料2=判斷2);白話一點意思就是當資料1滿足判斷1並且(AND的意思)資料2也等於判斷2時,才算成立,等等歐這樣還不夠!!((資料1=判斷1)*(資料2=判斷2),資料1),小編在這補上資料1表示當條件成立時加總資料1的資料;延伸一下,((資料1=判斷1)*1*(資料2=判斷2))這樣勒!!差在那,會變成計算資料1的個數歐,大概簡單說到這裡。

為了改進SUMPRODUCT的運算缺點,小編配合VBA語法,以儲存格物件的Formula屬性結合SUMPRODUCT語法做一點小改善,所以小編做了一個按鈕,把SUMPRODUCT用公式方式寫入Formula屬性中。

範例:

圖1.原始資料

圖2.SUMPRODUCT彙整結果頁面

VBA CODE:
Private Sub CommandButton1_Click()
Dim a, b, c As Integer '宣告a,b,c為整數
Dim d As String
Dim objsheet As Worksheet
I = 2
While Sheet1.Range("C" & I) <> ""
a = "D" & I
d = "C" & I
H = "E" & I
K = "F" & I
Sheet1.Range("D" & I).Formula = "= SUMPRODUCT((Item = " & d & ") * (日期 >= A2) * (日期 <= B2),入庫)"
Sheet1.Range("D" & I).Calculate
Sheet1.Range("E" & I).Formula = "= SUMPRODUCT((Item = " & d & ") * (日期 >= A2) * (日期 <= B2),請料)"
Sheet1.Range("E" & I).Calculate
Sheet1.Range("F" & I).Formula = "= SUMPRODUCT((Item = " & d & ") * (日期 >= A2) * (日期 <= B2),結餘)-" & H & "+" & a
Sheet1.Range("F" & I).Calculate
I = I + 1
Wend
Sheet1.Range("D2:F" & I).Copy
Sheet1.Range("D2").PasteSpecial xlPasteValuesAndNumberFormats '這一行會僅留下結果,去除公式
MsgBox "試算完成" & I - 2 & "筆 完成"
End Sub
簡單說明:雙引號間的資料透過&符號串在一起,然後透過等號寫入Formula ;紅色字體的d為變數,透過d = "C" & I,I為迴圈的步進值,用賴配合"C",做變數的設定,例如"C" & 1則變數d為"C1",以此類推"C" & 10,則為"C10"。在變數d=C10情況下,"= SUMPRODUCT((Item = " & & ") * (日期 >= A2) * (日期 <= B2),入庫)" 則在Formula 會成為SUMPRODUCT((Item = C10) * (日期 >= A2) * (日期 <= B2),入庫)這樣!

Sheet1.Range("D" & I).Formula = "= SUMPRODUCT((Item = " & d & ") * (日期 >= A2) * (日期 <= B2),入庫)" 

步驟:
1.先定義"名稱"
2.寫一個函數版的SUMPRODUCT,測試OK後,在參考小編的CODE,做一個按鈕,貼上CODE後,依樣畫葫蘆參考自己寫的SUMPRODUCT函數做修改。
   依樣畫葫蘆(1):
CODE中的d = "C" & I;這邊是你要拿ITEM跟誰比較的對象設定,比較對象"C"行組合數字來匹配儲存格,所以每一列比對的對象,都是不同的ITEM號碼歐。小編的I是從數字2開始編歐( I = 2),然後透過While迴圈檢查C行有無資料歐,所以有改到"C"則有2處要修改歐(分別是: d = "C" & I、    While Sheet1.Range("C" & I) <> "") 
圖3.SUMPRODUCT彙整比對對象(C行;紅框)

   依樣畫葫蘆(2):
參考小編的CODE,修改 * (AND)條件,或是>、<、=、<=、>=等邏輯與判斷條件。
   依樣畫葫蘆(3):
參考小編的CODE,把名稱改掉;例如ITEM、日期、入庫。
    依樣畫葫蘆(4):
Sheet1.Range("D" & I).Formula :"D" 用來控制寫在哪一行,這邊有D、E、F行,可以單獨一個或多個自行視需要做修改即可,但這邊的修改請一併修改 Sheet1.Range("D2:F" & I).Copy顏色字體標示的部分,例如,單行"D",則改為"D2:D",多行C、D、E則"C2:E",以此類推。
    依樣畫葫蘆(5):
Sheet1.Range("D2").PasteSpecial xlPasteValuesAndNumberFormats;顏色字體標示的部分,類似前步驟,但不管單一或多儲存格,僅要寫第一個位置的儲存格即可。

解說:有人可能會想,不就是自動寫入SUMPRODUCT函數,還不是一樣每次輸入資料會卡頓!!! 小編最後程式碼倒數第二行,這行功能為貼上資料,所以寫的函數公式會被自動蓋掉,自然沒卡頓問題。

Sheet1.Range("D2").PasteSpecial xlPasteValuesAndNumberFormats '這一行會僅留下結果,去除公式







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

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

昨晚想到沒寫怎應用:下

2020年12月6日 星期日

VBA:矩陣計算(相乘)

一、前言:

在算迴歸時,有使用到矩陣計算,所以小編分享一下矩陣乘法計算;

矩陣乘法一開始我在寫的時候是用雙迴圈概念,後來發現不對,有些組合永遠跑不到,所以改成用陣列方式來完成;目前還沒想到如何多矩陣相乘,還停在2個矩陣相乘。

二、發想:

透過Application.InputBox來取的資料儲存格位置。

副程式:

矩陣相乘有一部分是要與前回計算結果相加,這部分單獨靠迴圈明顯不足,這邊先寫一個副程式,名稱叫MATRIX_CAL,透過丟入2個矩陣當參數方式,用來計算矩陣相乘積與加總和。

主程式:

A矩陣:用I迴圈堆壘第一個矩陣成A矩陣,

B矩陣:用J迴圈堆壘第二個矩陣成B矩陣,並用J迴圈控制呼叫MATRIX_CAL的次數,然後每次呼叫時把A與 B矩陣當引數丟給MATRIX_CAL。

輸出:使用之前小編寫的sheet_name_check_delete這個副程式,下文字資料的引數"矩陣相乘結果"做執行;新增表單後,透過新的I與J迴圈將計算結果寫入工作表中

三、來做做:

先做一個VBA的AxtiveX命令按鈕

然後貼上code:


'COPYRIGHT BY dropit.liu.
Private Sub CommandButton1_Click()
On Error GoTo LINE1
Dim Total As Variant
'取得儲存格資料
AA_INPUTBOX_address = Application.InputBox("選擇A矩陣的儲存格範圍", Type:=8).Address '取得位置
AA_INPUTBOX = ActiveSheet.Range(AA_INPUTBOX_address).Value '取得資料,但其實上一行就可以了,換一種寫法
Bb_INPUTBOX_address = Application.InputBox("選擇B矩陣的儲存格範圍", Type:=8).Address '取得位置
BB_INPUTBOX = ActiveSheet.Range(Bb_INPUTBOX_address).Value '取得資料
ReDim Total(1 To UBound(AA_INPUTBOX, 1), 1 To UBound(BB_INPUTBOX, 2)) As Variant
'暫存資料用
ReDim A(UBound(AA_INPUTBOX, 1))
ReDim B(UBound(BB_INPUTBOX, 1))
'計算
For I = LBound(AA_INPUTBOX) To UBound(AA_INPUTBOX) Step 1
For II = LBound(AA_INPUTBOX) To UBound(AA_INPUTBOX, 2) Step 1
A(II - 1) = AA_INPUTBOX(I, II)
Next II
For J = LBound(BB_INPUTBOX) To UBound(BB_INPUTBOX, 2) Step 1
For JJ = LBound(BB_INPUTBOX) To UBound(BB_INPUTBOX, 1) Step 1
B(JJ - 1) = BB_INPUTBOX(JJ, J)
Next JJ
MATRIX_CALOUT = MATRIX_CAL(A, B)
Total(I, J) = MATRIX_CALOUT
Next J
Next I
'輸出
Call sheet_name_check_delete("矩陣相乘結果")
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "矩陣相乘結果"
For I = LBound(Total) To UBound(Total, 1)
For J = LBound(Total) To UBound(Total, 2)
If Total(I, J) <> "" Then
Sheets("矩陣相乘結果").Cells(I, J) = Total(I, J)
End If
Next J
Next I
Exit Sub
LINE1:
MsgBox "ERROR"
Resume
End Sub
Function MATRIX_CAL(A, B)
For I = LBound(A) To UBound(A) Step 1
MATRIX_CAL = MATRIX_CAL + A(I) * B(I)
Next
End Function

測試資料:

圖1.A與B矩陣

操作:貼上以上CODE後,點選按鈕後,會有對話框做如下操作。
 
圖2.A矩陣輸入(位置任選)

圖3.B矩陣輸入(位置任選)

圖4.結果

以前老長官名言"問題僅有一個,方法有好幾個"
似乎在程式語言當中,也是這樣,小編簡單整理與紀錄自己的小作品


2020年12月2日 星期三

VBA:自動寫存檔

 小編,經常處理很多案子要存檔,感覺滿實用的,寫一篇作整理。

副程式作動原理很簡單,就是直接複製一份要存檔的工作表後,直接存檔,不影響主要作業的工作表。

副程式:

'COPYRIGHT BY dropit.liu.
Function savefile_by5(SOLDTONO, SHEET_TAG,FILE_TYPE)
FILEPATH = ActiveWorkbook.Path
Source = Excel.ActiveWorkbook.Name
Sheets(SHEET_TAG).Copy
WORKNAME = Excel.ActiveWorkbook.Name
'準備存檔輸出。
Application.DisplayAlerts = False
With ActiveWorkbook
A = "Report_" & SOLDTONO & "_" & Format(Now(), "YYYYMMDDHHMM")
Save_Name = FILEPATH & "\" & A
.SaveAs Filename:=Save_Name, FileFormat:=FILE_TYPE
End With
WORKNAME = Excel.ActiveWorkbook.Name
Application.DisplayAlerts = True
Workbooks(WORKNAME).Close
Workbooks(Source).Activate
savefile_by5 = A
End Function


主要有3個參數,
SOLDTONO:設定輸出檔案名稱;EX:"Report_"
SHEET_TAG:要另存新黨的工作表;EX:"SHEET1"
FILE_TYPE:檔案存檔類型;EX:52;此部分可參考MSDN資料
Save_Name = FILEPATH & "\" & A;這一行根據FileFormat:=FILE_TYPE的設定,自己加上& ".xlsm" 這部分歐

應用1:例如現在想要針對"工作表1"作單獨輸出,可以這樣設定(當然要弄一個按鈕先):

Private Sub CommandButton1_Click()
Call savefile_by5("test", "工作表1", 52)
End Sub
view raw gistfile1.txt hosted with ❤ by GitHub

那這時候去檢查目前檔案所在的資料夾就會多一個存檔結果!!

圖1.
應用2:例如現在想要針對"工作表1、工作表2、工作表3"作多輸出,可以這樣設定:




Private Sub CommandButton2_Click()
SHEET_TAG = Array("工作表1", "工作表2", "工作表3")
Call savefile_by5("test", SHEET_TAG , 52)
End Sub

VBA:移除所有重複資料的簡單應用

 一般移除重複,透是透過RemoveDuplicates 這各RANGE的方法作執行,但如果要移除所有重複呢!!

今天早上M01某網友貼文,我簡單回了他,但是發現他的問題就是要移除所有重複。

小編分享自己目前手上有得副程式,主要是透過搜尋,把所有重複"資料"的位置找出來,作任何你想要的處理,例如刪除資料。

COPYRIGHT BY dropit.liu.
Function 找重複值的位置(SHEET_NAME, Target, ADD_ROW, ADD_COLUMN, range_to_range As String)
'SHEET_NAME: 搜尋表單名
'TARGET: 找尋的目標值
'ADD_ROW: ROW增值
'ADD_COLUMN: COLUMN增值
'2018.5.18 增加當無重複時自動離開迴圈
SHEET_NAME_A = SHEET_NAME
合計_add = 0
Set M_RNFIND = Sheets(SHEET_NAME_A).Range(range_to_range).Find(WHAT:=Target)
If Not M_RNFIND Is Nothing Then
m_stAddress = Sheets(SHEET_NAME_A).Cells(M_RNFIND.Row + ADD_ROW, M_RNFIND.Column + ADD_COLUMN).Address
Do
Set M_RNFIND = Sheets(SHEET_NAME_A).Range(range_to_range).FindNext(M_RNFIND)
If M_RNFIND Is Nothing Then
Exit Do
End If
If Target = Sheets(SHEET_NAME_A).Range(M_RNFIND.Address) Then
合計_add = 合計_add + 1
End If
Loop While Not M_RNFIND Is Nothing And M_RNFIND.Address <> m_stAddress
ReDim 合計(合計_add)
合計_add = 0
'AGAIN
m_stAddress = ""
Set M_RNFIND = Sheets(SHEET_NAME_A).Range(range_to_range).Find(WHAT:=Target)
If Not M_RNFIND Is Nothing Then
'm_stAddress = m_rnFind.Address
合計(合計_add) = M_RNFIND.Address
'Unhide the column, and then find the next X.
Do
If Target = Sheets(SHEET_NAME_A).Range(M_RNFIND.Address) Then
合計(合計_add) = Sheets(SHEET_NAME_A).Cells(M_RNFIND.Row + ADD_ROW, M_RNFIND.Column + ADD_COLUMN).Address
End If
' TARGET_LEN = Len(Sheets(SHEET_NAME_A).Cells(M_RNFIND.Row + ADD_ROW, M_RNFIND.Column + ADD_COLUMN))
Set M_RNFIND = Sheets(SHEET_NAME_A).Range(range_to_range).FindNext(M_RNFIND)
If M_RNFIND Is Nothing Then
Exit Do
End If
If Target = Sheets(SHEET_NAME_A).Range(M_RNFIND.Address) Then
合計_add = 合計_add + 1
End If
BV = Filter(合計, M_RNFIND.Address)
If UBound(BV) >= 0 Then
Exit Do
End If
Loop While Not M_RNFIND Is Nothing And M_RNFIND.Address <> m_stAddress
End If
End If
If Val(合計_add) = 0 Then
找重複值的位置 = 0
Exit Function
End If
找重複值的位置 = 合計
End Function
view raw gistfile1.txt hosted with ❤ by GitHub


設定以下參數即可運作:

SHEET_NAME, Target, ADD_ROW, ADD_COLUMN, range_to_range As String

SHEET_NAME:要搜尋的工作表名;EX:ACTIVESHEET.NAME OR "SHEET1"

Target:要搜尋的關鍵字,EX:"P10"

ADD_ROW:搜尋到資料時後,指定抓的列數的加減數;EX:1,-1

ADD_COLUMN:搜尋到資料時後,指定抓的行數的加減數;EX:1,-1

range_to_range :要搜尋那一列;EX:"A:A"

例如類似M01這位的問題,我自己作一個簡單的DEMO,作一個按鈕插入如下的CODE跟上面的副程式。

Private Sub CommandButton1_Click()
OUT = 找重複值的位置(ActiveSheet.Name, "P10", 0, 0, "A:A")
For Each A In OUT
If A <> "" Then
ActiveSheet.Range(A) = ""
End If
Next
End Sub
view raw gistfile1.txt hosted with ❤ by GitHub


圖1.
P.S資料在A行中。



指數變化(2025.03.20)

  指數變化(2025.03.20) 上周焦點: 美國紐約州製造業指數 -20 美國企業庫存月增率 +0.3% 美國零售額月增率  +0.1% FED 不升息 川普 名句:對等關稅是具備彈性的 本周愛看: 美國消費者信心指數 3/25 美國耐久財訂單月增率 3/26       ...