[VBA] 簡單幾步驟，設計上市櫃殖利率排行表

[VBA] 簡單幾步驟，設計上市櫃殖利率排行表

何謂殖利率 ?

[ 殖利率 ] :
※ 殖利率 = 股息 ÷ 股價，也就是將每年配發的現金股利，當作利息來計算的報酬率。

殖利率相關說明

[ 殖利率高低 ] : 如何來定義?
◎ 查找目前 2022年各大銀行定存利率 — 最高2.0%，所以一般會以 4% 殖利率作為基準，超過 4%以上 的股票，就可稱為 高殖利率。

[ 殖利率 vs 股價 ] :
◎ 依殖利率的計算公式 : 固定配息 — 則股價越低，殖利率越高。
◎ 倘若股息未達之前水準，卻擁有高殖利率，這時必須小心求證公司的財務狀況，是否出了問題，而產生高殖利率的假象。

[ 殖利率選股 ] :
◎ 殖利率 : 4% 以上。
◎ 5 ~ 10年穩定配息，年年增長為佳。
◎ 年營收成長率( YoY ) 為正值，年年增長為佳。
◎ 5日成交均量 : 500張以上。

[ 殖利率查詢 ] :
◎ 證交所網站 : https://www.twse.com.tw/zh/page/trading/exchange/BWIBBU_d.html，提供上市公司個股 本益比 / 殖利率 / 股價淨值比 查詢及下載。
◎ 櫃買中心網站 : https://www.tpex.org.tw/web/stock/aftertrading/peratio_analysis/pera.php?l=zh-tw，提供上櫃公司個股 本益比 / 殖利率 / 股價淨值比 查詢及下載。
◎ 並於交易日 下午 06:00，進行本益比 / 殖利率 / 股價淨值比資料更新。

[ 殖利率排行 ] :
◎ 理財網 : https://www.moneydj.com/Z/ZG/ZGL/ZGL.djhtm
◎ 玩股網 : https://www.wantgoo.com/stock/dividend-yield
◎ 財報狗 : https://statementdog.com/screeners/dividend_yield_ranking
※ PS. 僅列舉三家，各家皆有提供相關的資料查詢，大家自行研究。

…………… 自行研究? 這麼簡單就把文章搞定了? 哈哈
◎ 當然不是這樣 ! 是想讓大家先了解投資網站都提供那些資料，才好切入，製作出適合的分析程式。

上市櫃殖利率排行資料抓取

首先利用 EXCEL 上網抓取上市/上櫃的殖利率資料，再將下載的資料整合，作殖利率排行排序，這樣簡單的上市櫃殖利率排行表，就大功告成了。

◎ 了解操作的程序，就可以開始進行製作。

[ 資料抓取 – 操作步驟 ]

0. 我使用的作業系統是 : Office 365。
1. 新增一個 EXCEL 的空白活頁簿。
2. 先另存新檔，存檔位置 : 自行設定，檔案名稱 : 自行設定 ( 我設 : 2022_殖利率排行表 )，存檔類型(副檔名) : .xlsm ( 啟用巨集的活頁簿 )。
3. 取得當日上市/上櫃個股殖利率的下載網址(HTML)。

☆ 上市公司殖利率

◎ 上市公司殖利率查詢 : https://www.twse.com.tw/zh/page/trading/exchange/BWIBBU_d.html，畫面圖示如下 :

◎ 參考上圖，點選 — 步驟二 : 由每頁10筆改成全部。
◎ 再按 : 滑鼠右鍵，點選 — 步驟三 : 列印 / HTML，選擇 : 在新分頁中開啟連結，或直接選擇 : 複製連結網址，因為這個步驟的主要目的就是要取得本益比 / 殖利率 / 股價淨值比的資料網址 : https://www.twse.com.tw/exchangeReport/BWIBBU_d?response=html&date=20220429&selectType=ALL，方便之後VBA程式的資料抓取。( PS. 頁面開啟的畫面，如下。)

☆ 上櫃公司殖利率

◎ 上櫃公司殖利率查詢 : https://www.tpex.org.tw/web/stock/aftertrading/peratio_analysis/pera.php?l=zh-tw，畫面圖示如下 :

◎ 產業類別 : 已設定選擇 — 全部，所以無需再做更改。
◎ 直接滑鼠左鍵，點選 — 步驟二 : 列印 / 匯出HTML ( 這步驟與上市公司不同)，此動作會開啟新分頁，顯示上櫃公司當日所有個股的本益比 / 殖利率 / 股價淨值比資料。但我們的主要目的是要取得下圖上方的資料網址 : https://www.tpex.org.tw/web/stock/aftertrading/peratio_analysis/pera_result.php?l=zh-tw&o=htm&d=111/04/29&c=&s=0,asc，方便之後VBA程式的資料抓取。

4. 有了上市/上櫃的HTML網址資料，就可以如同之前大盤成份股的抓取方式，將所有個股殖利率的資料，抓進自設的上市/上櫃的工作表內，參考下圖。

※ 若忘記網路資料抓取的方式，請參考 : 抓取 – 大盤成份股權重資料 的抓取步驟。

上市櫃殖利率排行資料整合

取得上市/上櫃個股的殖利率資料後，你會發現一件事；上市與上櫃公司所提供的欄位資料並不相同，上市公司少了一個 每股股利 的欄位資料，這時你要考慮的是 : 要補上上市公司每股股利的資料，還是乾脆刪除上櫃的股利資料。

由於只想簡單的製作上市櫃整合的殖利率排行表，既然已經有了殖利率的資料，就無需再大費周章，去抓取上市公司的股利資料，直接刪除上櫃的股利欄位，即可。

[ 資料整合步驟 ] :

1. 首先要將上市與上櫃的欄位資料作刪除與整理。經處理後，僅留下 證券代號 / 證券名稱 / 殖利率(%) / 股利年度 / 本益比 / 股價淨值比 等欄位。
◎ 上市公司欄位整理程序 : 將 A欄(Header) 與 H欄(財報年/季) 刪除，即可。

◎ 上櫃公司欄位整理程序 : 為了配合上市公司的資料欄位，所以程序上要麻煩些，步驟如下 :
A. 刪除 A欄(Header) 及 E欄(每股股利)。
B. 將 G欄(殖利率(%)) 剪下，貼到 F欄(股利年度) 前面(左邊)。
C. 再將 D欄(本益比) 剪下，貼到 H欄(股價淨值比) 前面(左邊)。

2. 在上市櫃資料複製前，要先處理一件事，哪就是日期。不然你會不了解這些資料是哪天的，是否已經更新過。
◎ 步驟如下 :
A. 在 上市櫃殖利率排行 工作表 A1欄，填入文字 : 更新日期。

B. 為了避免在 非交易日 做更新數據的動作，而導致錯誤發生。所以在 B1欄設定 XQ RTD語法 : =RTD(“xqrtd.rtdserverxqlite”,,”TSE.TW-TradingDate”)，來抓取大盤交易日的最新日期。( 注意 : 運用 XQ DDE/RTD語法，一定要將 XQ系統開啟，否則同樣會產生錯誤。)

2. 處理好上市櫃的資料欄位後，進行資料複製。
◎ 步驟如下 :
A. 首先點選 A1欄位，然後按 : CTRL + SHIFT + →，再按 : CTRL + SHIFT + ↓(範圍選取) 後，再按 : 滑鼠右鍵 — 複製 或 CTRL + C (複製) 後，切換到 上市櫃殖利率排行 工作表，點選 A3欄位後，按 : 滑鼠右鍵 — 貼上 或 CTRL + V，皆可。

B. 複製好上市資料後，切換到上櫃工作表，這次不需要複製標題名稱，同步驟A，先點選 A2欄位，然後按鍵盤 : CTRL + SHIFT + →，再按 : CTRL + SHIFT + ↓(範圍選取) 後，再按 : 滑鼠右鍵 — 複製 或 CTRL + C (複製) 後，切換至 上市櫃殖利率排行 工作表，點選 A3欄或以下有資料的欄位，按 : CTRL + ↓，游標移動到 A欄最後一列 (963列)，再點選下一新列 (964列)，按 : 滑鼠右鍵 — 貼上 或 CTRL + V，將上櫃個股資料貼上。

C. 整合好的上市櫃個股殖利率資料，如下 :

D. 因為採用表格的展現方式，更方便做 資料排序 的處理。只要按下 : C3欄(殖利率%) 的右邊 ▼ 箭頭，選擇 : 從最大到最小排序。

E. 當日的 上市櫃殖利率排行，就完成了。如下圖所示 —

殖利率排行每日更新

了解以上的操作步驟，便能將其轉化成 VBA指令，自動化執行個股殖利率的排序動作。

[ 轉化VBA – 操作步驟 ] :

[ 程式 ] 網路資料下載 / 整理

0. 首先，若你有根據 抓取 – 大盤成份股權重資料 內的講解方式，來抓取上市/上櫃個股殖利率的話。你的VBA程式裡，會多一個 Module1 的巨集模組，裡面會有兩個副程式 : 巨集1 & 巨集2。程式如下 :

Sub 巨集1()

    Application.CutCopyMode = False
    ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    來源 = Web.Page(Web.Contents(""https://www.twse.com.tw/exchangeReport/BWIBBU_d?response=html&date=20220429&selectType=ALL""))," & Chr(13) & "" & Chr(10) & "    Data0 = 來源{0}[Data]," & Chr(13) & "" & Chr(10) & "    已變更類型 = Table.TransformColumnTypes(Data0,{{""Header"", type text}, {""證券代號"", Int64.Type}, {""證券名稱"", type text}, {""殖利率(%)"", type number}, {""股利年度"", Int64.Type}, {""本益比"", type text}, {""股價淨值比"", type" & _
        " number}, {""財報年/季"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    已變更類型" & _
        ""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 0]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_0"
        .Refresh BackgroundQuery:=False
    End With

End Sub

Sub 巨集2()

    Application.CutCopyMode = False
    ActiveWorkbook.Queries.Add Name:="上櫃股票個股本益比、殖利率、股價淨值比(依日期查詢)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    來源 = Web.Page(Web.Contents(""https://www.tpex.org.tw/web/stock/aftertrading/peratio_analysis/pera_result.php?l=zh-tw&o=htm&d=1110429&s=0,asc""))," & Chr(13) & "" & Chr(10) & "    Data0 = 來源{0}[Data]," & Chr(13) & "" & Chr(10) & "    已變更類型 = Table.TransformColumnTypes(Data0,{{""Header"", type text}, {""股票代號"", Int64.Type}, {""名稱"", type text}, {""本益比"", type text}, {""每股股利"", type number}, {""股利年度"", Int64.Type}," & _
        " {""殖利率(%)"", type number}, {""股價淨值比"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    已變更類型" & _
        ""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=上櫃股票個股本益比、殖利率、股價淨值比(依日期查詢);Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [上櫃股票個股本益比、殖利率、股價淨值比(依日期查詢)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "上櫃股票個股本益比_殖利率_股價淨值比_依日期查詢"
        .Refresh BackgroundQuery:=False
    End With
    
End Sub

[ 提醒 ] : 若沒有上述的副程式 : 巨集1 & 巨集2，請參考 : 抓取 – 大盤成份股權重資料 的操作步驟，將 上市櫃個股殖利率 的巨集模組做出來。

1. 有了 Module1 的巨集模組及兩個副程式 : 巨集1 & 巨集2。表示你已經新增了模組，將其 Module1 改名為 : 更新_上市櫃殖利率排行表。

[ 注意 ] : 巨集1 & 巨集2 所抓取的殖利率資料是當天 2022/04/29，這是固定日期；若想每天自動化更新，便要將日期部分改用變數來定義，設定抓取 XQ RTD 下載的 大盤交易日期，如此便能一鍵完成上市/上櫃所有個股值利率資料的下載與排序。

[ 每日更新_日期變數設定 ]
※ 首先找出上市/上櫃公司巨集程式內的日期位置。

A. 巨集1 (上市公司網址) : “”https://www.twse.com.tw/exchangeReport/BWIBBU_d?response=html&date=20220429&selectType=ALL””，程式碼內 20220429 : 是以西元年作編排格式。

B. 巨集2 (上櫃公司網址) : “”https://www.tpex.org.tw/web/stock/aftertrading/peratio_analysis/pera_result.php?l=zh-tw&o=htm&d=1110429&s=0,asc””，程式碼內 1110429 : 是以民國年作編排格式。

C. 了解上市/上櫃程式碼內的日期位置與編排格式，那 大盤交易日期(變數) 就要改成符合的編排格式，程式才不會出錯。
◎ 首先確定 大盤交易日期，所在的位置 : 工作表 上市櫃殖利率排行(B1欄)。
[ 程式 ] : OrderDay = Format([B1], “yyyymmdd“)，運用 Format函式語法，將 B1欄的日期格式，改為 yyyymmdd 西元年格式型態。
[ 程式 ] : ChineseDay = Int(Format([B1], “yyyymmdd“)) – 19110000，同上做法，先將其改為西元年格式，再轉換成數值型態，減掉 19110000，得到的數值，就是民國年格式型態。

D. 求得 OrderDay(西元年) 與 ChineseDay(民國年) 資料變數，再運用 文字組合 的功能，將 巨集1 & 巨集2 的日期資料，轉變成變數型態，即可。( PS. 若不懂 文字組合 的串接運用，請參考 : VBA指令 – 文字組合。
[ 巨集1 變數串接 ] : “”https://www.twse.com.tw/exchangeReport/BWIBBU_d?response=html&date=” & OrderDay & “&selectType=ALL””，將上市公司當日下載日期，改用 OrderDay 變數串接，完成自動化更新形態。
[ 巨集2 變數串接 ] : “”https://www.tpex.org.tw/web/stock/aftertrading/peratio_analysis/pera_result.php?l=zh-tw&o=htm&d=” & ChineseDay & “&s=0,asc””，將上櫃公司當日下載日期，改用 ChineseDay 變數串接，完成自動化更新形態。

☆ 完整的公式列表，將在 完整程式碼 裡展示。

2. 將 巨集1 & 巨集2 程式合併 : 去除巨集1的尾 ( End Sub ) 及 巨集2的頭 ( Sub 巨集2() )，如此便只剩下 巨集1。
3. 將 巨集1 副程式名稱，改為 : 上市櫃殖利率排行表_更新 。

[ 注意 ] : 完成程式合併的動作，自動化更新程式的設計正式開始 — 還記得之前的程式教學有說過，透過VBA網路資料抓取，會需要一塊空白區域，來放置新的下載資料，所以有兩種做法 : 1. 新增新工作表 / 2. 刪除工作表的內容資料。
( PS. 不建議用 1，因為日子久了，程式會變大，造成系統負擔。採用第 2 方式是最理想的，只要一個指令 Delete，就能搞定。)

4. 刪除工作表舊資料 :
(一) : 網路下載的資料有兩組 : 上市/上櫃殖利率資料，所以程式也需要有2個工作表導向指令，引導程式到上市及上櫃工作表裡，刪除舊有資料。
(二) : 整合上市/上櫃殖利率資料的工作表 : 上市櫃殖利率排行，裡面的內容資料，也需要一併清除。

[ VBA程式修改 — 刪除舊資料 ] : 如下圖 —

( PS. 上網抓取資料前，先把舊資料刪除，才能執行下載資料的動作，否則會造成錯誤。)

5. 切斷查詢連線 : 為避免連線膨脹，導致系統負載過大，造成死機。最好的解決方法，就是刪除連線。詳細解說 — 請參考 : 切斷查詢連線。

[ VBA程式修改 — 刪除查詢連線 ] : 如下圖 —

[ 注意 ] : 對應的連線位置，名稱一定要對，否則無法刪除連線。

[ 程式 ] 上市櫃殖利率排行資料整合

※ 上市櫃殖利率資料，經VBA網路下載完成後，便可依照 上市櫃殖利率排行資料整合 步驟，來進行程式編寫。

1. 上市公司殖利率資料整合 :

    [ 程式碼 ] :
    Sheets("上市").Select
    Columns("H").Delete  ' 刪除 財報年/季 欄位
    Columns("A").Delete  ' 刪除 Header 欄位
    
    Range("A1").Select  ' 從 A1欄 開始選取
    Range(Selection, Selection.End(xlToRight)).Select  ' 範圍選取 -- CTRL + →
    Range(Selection, Selection.End(xlDown)).Select  ' 範圍選取 -- CTRL + ↓
    Selection.Copy  ' 複製 -- 選取的範圍資料
    
    Sheets("上市櫃殖利率排行").Select
    Range("A3").Select  ' 選取 A3欄
    ActiveSheet.Paste  ' 將範圍選取的資料，直接貼上 -- 保留表格格式

◎ 整合步驟解說 — 請參考 [ 資料整合步驟 ] — 步驟 2 – A。

2. 上櫃公司殖利率資料整合 :

[ 程式碼 ] :
Sheets("上櫃").Select  ' 選取"上櫃"工作表
Columns("G").Cut  ' 剪下 殖利率(%) 欄位
Columns("D").Select  ' 選擇欲貼上之欄位位置 -- D欄
Selection.Insert Shift:=xlToRight  ' 選擇 : 貼上 -- 原資料欄位向右搬移

Columns("E").Cut  ' 剪下 本益比 欄位
Columns("H").Select  ' 選擇欲貼上之欄位位置 -- H欄
Selection.Insert Shift:=xlToRight  ' 選擇 : 貼上 -- 原資料欄位向右搬移

Columns("E").Delete  ' 刪除 每股股利 欄位
Columns("A").Delete  ' 刪除 Header 欄位

Range("A2").Select  ' 從 A2欄 開始選取
Range(Selection, Selection.End(xlToRight)).Select  ' 範圍選取 -- CTRL + →
Range(Selection, Selection.End(xlDown)).Select  ' 範圍選取 -- CTRL + ↓
Selection.Copy  ' 複製 -- 選取的範圍資料

Sheets("上市櫃殖利率排行").Select  ' 切換至"上市櫃殖利率排行"工作表
newRow = Range("A1").End(xlDown).Row + 1 ' 搜尋最後一列後的無資料新列 -- 列數
Range("A" & newRow).Select  ' 選取 A欄最新列
ActiveSheet.Paste  ' 將範圍選取的資料，直接貼上 -- 保留表格格式

◎ 整合步驟解說 — 請參考 [ 資料整合步驟 ] — 步驟 2 – B。

3. 上市櫃殖利率整合資料，依照殖利率(大→小)排列 :

[ 程式碼 ] :
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects("Table_021622").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects("Table_021622").Sort. _
    SortFields.Add2 Key:=Range("Table_021622[[#All],[殖利率(%)]]"), SortOn:= _
    xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects("Table_021622").Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

◎ 利用 錄製巨集 的方法，來取得 [ 資料整合步驟 ] — 步驟 2 – D 的動作公式。

[ 注意 – 產生物件錯誤 ] :
※ 錄製完 — 殖利率大小排列，啟動自動更新時，你會發現產生了物件錯誤。

◎ 其問題出在 EXCEL 365版本，每次數據更新，重新建立新表格時，系統會主動給予新表格_編號名稱 ( 如上程式 : ListObjects(“Table_021622“)，表格名稱 : Table_021622，便是系統主動給予 )。
◎ 問題重點是 : 系統每次給予的名稱均不相同，這樣在自動化更新時，會產生物件錯誤。

[ 解決方法 ] :
※ 首先了解一件事，表格同活頁簿/工作表，在系統內會有一個順序編號。第一個建立的為 : 1，再來為 : 2，活頁簿內有幾個表格，就會賦予 1 ~ X 的編號，這是固定的，所以可以藉由這個規則，來解決上述的錯誤問題。

◎ 程式內 : ListObjects(“Table_021622“) 改為 ListObjects( 1 )，即可。

[ 程式語法錯誤 ] :
※ 但當你把程式碼 : ListObjects(“Table_021622“) 內的 “Table_021622“，全改為 : 1 ，你會發現有一組 : Range(“Table_021622[[#All],[殖利率(%)]]”)，改完後，還是產生 Range語法錯誤 ( 那是語法編寫的問題，在這就不討論了 )，這該如何是好?

※ 那就換另外一個方法 : 固定表格名稱。

◎ 已知固定表格的編號為 : 1。
◎ 要得知 表格1名稱(Name) 的VBA語法為 : ActiveWorkbook.Worksheets(“上市櫃殖利率排行”).ListObjects(1).Name
◎ 為避免更新時，表格名稱會不一樣，便給 表格1 設定一新名稱 : Table_X ( 自行設定，即可。)
◎ 固定表格名稱 : 其程式碼為 : ActiveWorkbook.Worksheets(“上市櫃殖利率排行”).ListObjects(1).Name = Table_X

※ 錯誤的Range語法，改為 : Range(“Table_X[[#All],[殖利率(%)]]”)，便可解決錯誤的情況。( PS. 正確的程式碼，修改如下 — )

☆ 正確的殖利率排序程式碼

    [ 程式碼 ] :    
    ' 上市櫃殖利率資料 -- 依殖利率(大→小)排列
    ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects(1).Name = "Table_X"
    
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects(1).Sort. _
        SortFields.Add2 Key:=Range("Table_X[[#All],[殖利率(%)]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

製作更新數據按鈕

※ 完成整合步驟公式，就可以在 下午:06:00 證交所更新個股殖利率資料後，一鍵完成 — 殖利率數據自動化更新 !

[ 更新數據_按鈕製作 ] :

1. 按鈕製作方法 : 請參考 — VBA 按鈕製作。

2. 指定巨集 : 游標移動到 更新數據 按鈕上，按滑鼠右鍵，點選 : 指定巨集。

3. 確定巨集名稱 : 出現 指定巨集 視窗後，選取 : 上市櫃殖利率排行表_更新 巨集名稱。

完整程式碼

Sub 上市櫃殖利率排行表_更新()

    ' 工作表 -- 上市櫃殖利率排行 舊資料清除
    Sheets("上市櫃殖利率排行").Select
    Range("A3:F10000").ClearContents  ' 清除內容
    
    OrderDay = Format([B1], "yyyymmdd")  ' 大盤交易日(西元年)
    ChineseDay = Int(Format([B1], "yyyymmdd")) - 19110000  ' 大盤交易日(民國年)

    ' 上市 / 殖利率 資料抓取
    Sheets("上市").Select
    Range("A:H").Delete

    Application.CutCopyMode = False
    ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    來源 = Web.Page(Web.Contents(""https://www.twse.com.tw/exchangeReport/BWIBBU_d?response=html&date=" & OrderDay & "&selectType=ALL""))," & Chr(13) & "" & Chr(10) & "    Data0 = 來源{0}[Data]," & Chr(13) & "" & Chr(10) & "    已變更類型 = Table.TransformColumnTypes(Data0,{{""Header"", type text}, {""證券代號"", Int64.Type}, {""證券名稱"", type text}, {""殖利率(%)"", type number}, {""股利年度"", Int64.Type}, {""本益比"", type text}, {""股價淨值比"", type" & _
        " number}, {""財報年/季"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    已變更類型" & _
        ""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 0]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_0"
        .Refresh BackgroundQuery:=False
    End With
    
    ' 切斷 "Table 0" 查詢連線
    ActiveWorkbook.Queries("Table 0").Delete

    ' --------------------------------------------------------------------------------
    ' 上櫃 / 殖利率 資料抓取
    Sheets("上櫃").Select
    Range("A:H").Delete

    Application.CutCopyMode = False
    ActiveWorkbook.Queries.Add Name:="上櫃股票個股本益比、殖利率、股價淨值比(依日期查詢)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    來源 = Web.Page(Web.Contents(""https://www.tpex.org.tw/web/stock/aftertrading/peratio_analysis/pera_result.php?l=zh-tw&o=htm&d=" & ChineseDay & "&s=0,asc""))," & Chr(13) & "" & Chr(10) & "    Data0 = 來源{0}[Data]," & Chr(13) & "" & Chr(10) & "    已變更類型 = Table.TransformColumnTypes(Data0,{{""Header"", type text}, {""股票代號"", Int64.Type}, {""名稱"", type text}, {""本益比"", type text}, {""每股股利"", type number}, {""股利年度"", Int64.Type}," & _
        " {""殖利率(%)"", type number}, {""股價淨值比"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    已變更類型" & _
        ""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=上櫃股票個股本益比、殖利率、股價淨值比(依日期查詢);Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [上櫃股票個股本益比、殖利率、股價淨值比(依日期查詢)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "上櫃股票個股本益比_殖利率_股價淨值比_依日期查詢"
        .Refresh BackgroundQuery:=False
    End With
    
    ' 切斷 "上櫃股票個股本益比、殖利率、股價淨值比(依日期查詢)" 查詢連線
    ActiveWorkbook.Queries("上櫃股票個股本益比、殖利率、股價淨值比(依日期查詢)").Delete
    
    ' --------------------------------------------------------------------------------
    ' 上市櫃殖利率資料 -- 整合
    Sheets("上市").Select
    Columns("H").Delete  ' 刪除 財報年/季 欄位
    Columns("A").Delete  ' 刪除 Header 欄位
    
    Range("A1").Select  ' 從 A1欄 開始選取
    Range(Selection, Selection.End(xlToRight)).Select  ' 範圍選取 -- CTRL + →
    Range(Selection, Selection.End(xlDown)).Select  ' 範圍選取 -- CTRL + ↓
    Selection.Copy  ' 複製 -- 選取的範圍資料
    
    Sheets("上市櫃殖利率排行").Select
    Range("A3").Select  ' 選取 A3欄
    ActiveSheet.Paste  ' 將範圍選取的資料，直接貼上 -- 保留表格格式
    
    ' ---------------------------------------------------------------------------
    Sheets("上櫃").Select
    Columns("G").Cut  ' 剪下 殖利率(%) 欄位
    Columns("D").Select  ' 選擇欲貼上之欄位位置 -- D欄
    Selection.Insert Shift:=xlToRight  ' 選擇 : 貼上 -- 原資料欄位向右搬移
    
    Columns("E").Cut  ' 剪下 本益比 欄位
    Columns("H").Select  ' 選擇欲貼上之欄位位置 -- H欄
    Selection.Insert Shift:=xlToRight  ' 選擇 : 貼上 -- 原資料欄位向右搬移
    
    Columns("E").Delete  ' 刪除 每股股利 欄位
    Columns("A").Delete  ' 刪除 Header 欄位
    
    Range("A2").Select  ' 從 A2欄 開始選取
    Range(Selection, Selection.End(xlToRight)).Select  ' 範圍選取 -- CTRL + →
    Range(Selection, Selection.End(xlDown)).Select  ' 範圍選取 -- CTRL + ↓
    Selection.Copy  ' 複製 -- 選取的範圍資料
    
    Sheets("上市櫃殖利率排行").Select
    newRow = Range("A3").End(xlDown).Row + 1 ' 搜尋最後一列後的無資料新列 -- 列數
    Range("A" & newRow).Select  ' 選取 A欄最新列
    ActiveSheet.Paste  ' 將範圍選取的資料，直接貼上 -- 保留表格格式
    
    ' ---------------------------------------------------------------------------
    ' 上市櫃殖利率資料 -- 依殖利率(大→小)排列
    ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects(1).Name = "Table_X"
    
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects(1).Sort. _
        SortFields.Add2 Key:=Range("Table_X[[#All],[殖利率(%)]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("上市櫃殖利率排行").ListObjects(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("B1").Select

End Sub

結論

本篇上市櫃殖利率排行，其設計重點 : 是將上市/上櫃的殖利率資料，做簡單的表格整合，再利用殖利率的排序選項，選擇 : 從大到小的排列組合，以達到順序排列，輕鬆查找高殖利率的目的。

「高殖利率」往往是存股族選擇投資的參考指標之一。但要注意的是高殖利率股的股價是「真被低估」，還是「公司營運出問題」，而造成股價過低的現象。所以為了避免有誤判的情況發生，增加些選股條件，有助於篩選出更優質的個股，再根據當月及當季的營收表現，才能更準確的判斷其投資的可行性。

至於該如何增加選股條件及月營收的判別，哪就牽扯到個股歷史資料的下載與建立。目前上市櫃公司股票有 : 1755檔，其龐大的歷史資料量，若採用EXCEL來處理，不僅耗時，還會拖垮系統效能，所以這裡先不討論選股的設計，等 Python教學正式上線，屆時會有正式的選股教學。

非常感謝您看到最後，若在閱讀的過程中，有任何疑問，歡迎您利用左下角 Messenger 直接提問或寫信給我，我會盡快回覆您，最後感謝您的閱讀，感恩 !

( PS. 如果喜歡 股小白 的文章，歡迎到 股小白臉書粉絲頁 點讚，衝人氣，目前不定期分析大盤趨勢，將來會有 每日公報 : 分析並公布跑分的個股資料，讓大家作為投資參考。 )

關聯文章

1. 簡單幾步驟，設計上市櫃殖利率排行表

上市櫃殖利率排行設計重點 : 是將上市/上櫃的殖利率資料，做簡單的表格整合，再利用殖利率的排序選項，確定排列順序，輕鬆查找高殖利率股。
但高殖利率股的股價是「真被低估」，還是「公司營運出問題」，而造成股價過低的現象，這是投資人必須詳加確認的重點，以避免有誤判的情況發生。

2. 小資族必看 ☆ 金融存股 <低買高賣> 的無痛賺錢法

[ 金融存股 ] 為主軸，哪幾支金融股最值得買進? 採樣15檔股本500億以上且穩定配息之金融股，按殖利率分析，再根據其慣性脈動，整合區間數據後，做出這15檔金融存股的殖利率區間買進/賣出參考表，同時計算出低買高賣的利潤價差，非常適合小資族與退休存股族，作為進/出場的投資參考。

V B A 資源

EXCEL & VBA功能 – 綜合筆記

EXCEL & VBA功能筆記 : 將針對文章中所使用的 EXCEL 及 VBA公式 / 工具操作 / 巨集設定 / 控制項的運用，做個整合記錄，方便大家在學習當下的參考與使用。

VBA指令 – 彙整筆記

VBA 提供相當多的指令用法，VBA指令彙整筆記，將會陸續記錄 VBA文章中，所用過的 VBA指令，方便學員們對照運用。

VBA程式語法 – 彙整筆記

語法就是程式的文法。使用者要與電腦溝通，就必須遵守這些規則。VBA程式語法筆記 : 將針對 VBA文章中所使用的 VBA程式語法，做個整合記錄，方便大家在學習當下參考與使用。

何謂 殖利率 ?

殖利率 相關說明

上市櫃殖利率排行 資料抓取