Excal：VBA，插入股票公開資料v1.3

插入股票公開資料的檔案我做了更新，供大家參考：
stock_sample_v1.3.xlsm
https://drive.google.com/open?id=1g5saowjYAeXNi73a0pss96-xZeXPUTXr

使用方式：
1. 「關注」的分頁C列填入股票代碼。
2.  點擊「關注」分頁左上「refresh」按鈕就可以刷新全部。
（判斷方式是16:00以前只刷新興櫃，16:00以後則全部更新。如果想假日更新最新的前一交易日，可以改TWN分頁的A10~A12）

調整內容：
1. 新增更新全部分頁的方式
2. 修正了櫃買中心的興櫃csv連結為：http://www.gretai.org.tw/storage/emgstk/ch/new.csv

目前問題：
1. 興櫃股票我抓的政府資料開放平臺的資料沒有前一天價格，所以沒有辦法算漲跌、漲跌幅和昨收。（如果有人知道哪邊抓的資料有漲跌或前一天價格可以跟我說一下）
2. P/E只有上市有。
3. 美股不知道哪邊有資料，有人知道那邊有美股類似證交所這樣一個表有全部股價資料的網站嗎？

新增的巨集內容如下。

Private Sub CommandButton1_Click()

Sheets("TWN").Select
'宣告變數
    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
    Dim NOW, BN, LTH As Long
    NOW = Sheets("TWN").Range("A4")
    BN = Sheets("TWN").Range("A9")
    LTH = Sheets("TWN").Range("A8")
'告訴Excel不要每更新一格就重新計算
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
'將現在的工作表設為資料表
    Set DataSheet = ActiveSheet
    qurl = "http://www.gretai.org.tw/storage/emgstk/ch/new.csv"
'選擇TWN sheet
    Sheets("TWN").Range("B:Z").Clear
        
If NOW >= BN Then
    If LTH < 16 Then
'如果時間是16:00之前
'抓取資料（TWN sheet）
QueryQuote:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
                .RefreshStyle = xlInsertEntireRows
                .Delete
            End With

'讓Excel重新活回來，讓資料能夠顯示
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
'切數據（TWN sheet）
        Sheets("TWN").Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True

'否則（如果時間是16:00之後）
Else


'抓取資料（TWN sheet）
QueryQuote2:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
                .RefreshStyle = xlInsertEntireRows
                .Delete
            End With

'讓Excel重新活回來，讓資料能夠顯示
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
'切數據（TWN sheet）
        Sheets("TWN").Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True
'更新上一交易日（TWN sheet的BN變數）
        Sheets("TWN").Range("A4:A7").Select
        Selection.Copy
        Sheets("TWN").Range("A9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'選擇TWO sheet
Sheets("TWO").Select

'告訴Excel不要每更新一格就重新計算
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
'將現在的工作表設為資料表
        qurl = "http://www.tpex.org.tw/web/stock/aftertrading/otc_quotes_no1430/stk_wn1430_print.php?l=zh-tw&d=" + Sheets("TWO").Range("A9") + "/" + Sheets("TWO").Range("A10") + "/" + Sheets("TWO").Range("A11") + "&se=EW&s=0,asc,0"
    Sheets("TWO").Range("B:Z").Clear
'抓取資料（TWO）
QueryQuote3:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("TWO").Range("B1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
                .RefreshStyle = xlInsertEntireRows
                .Delete
            End With
  
'讓Excel重新活回來，讓資料能夠顯示
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

'選擇TW sheet
Sheets("TW").Select

'將現在的工作表設為資料表
    Set DataSheet = ActiveSheet
    qurl = "http://www.tse.com.tw/exchangeReport/MI_INDEX?response=csv&date=" + Sheets("TW").Range("A9") + Sheets("TW").Range("A10") + Sheets("TW").Range("A11") + "&type=ALLBUT0999"
    Sheets("TW").Range("B:Z").Clear
'抓取資料（TW sheet）
QueryQuote4:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
                .RefreshStyle = xlInsertEntireRows
                .Delete
            End With

'讓Excel重新活回來，讓資料能夠顯示
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
'切數據（TW sheet）
        Sheets("TW").Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True
        
        End If
End If

'選擇關注 sheet
Sheets("關注").Select

End Sub

紀錄：

office 2010 64bit、2016 64bit可使用

epoch time：Linux or Unix時間轉換至Excel格式

 =(x+8*3600)/86400+70*365+19

但有些地方這個數值可能會被乘上1000
例如秒速記帳輸出的csv裡面：
x=1410969600000
y=(x/1000+8*3600)/86400+70*365+19
y則等於Excel日期時間格式的：2014/9/18 00:00

反過來則：
x=((y-70*365-19)*86400-8*3600)

參考資料原本來自於網路上「Unix時間戳轉換Excel時間_StackDoc」，但該連結已失效。

Excal：VBA，插入股票公開資料

google試算表跑資料很慢，而且抓不到上櫃和興櫃資料。

而且如果要跟我原本電腦裡的資料連結還要下載下來。

因為有用Excel做紀錄的習慣，所以還是直接匯在Excel的檔案裏面比較方便。


研究了幾天，把之前yahoo那個VBA，改成抓證交所、櫃買中心、政府資料開放平臺的方案，供大家參考：
https://drive.google.com/open?id=1Ekn1MIGolNi3bqoH-xfv16mD9Z_D0OoF

這是舊的，請改看新版：Excal：VBA，插入股票公開資料v1.3

（政府開放平台的興櫃資料我是查到這個：https://data.gov.tw/dataset/11398
因為我不知道怎麼解析櫃買中心的興櫃csv下載連結，有人知道的話可以跟我說下）

使用方式：
1. 「關注」的分頁C列填入股票代碼。
2.  點擊「TW」、「TWO」、「TWN」各分頁左上「refresh」按鈕就可以刷新。

目前問題：
1. 興櫃股票我抓的政府資料開放平臺的資料沒有前一天價格，所以沒有辦法算漲跌、漲跌幅和昨收。（如果有人知道哪邊抓的資料有漲跌或前一天價格可以跟我說一下）
2. P/E只有上市有。
3. 目前我只會每個分頁各自加一個按鈕，但我不知道怎麼樣做可以一個按鈕直接刷新三個分頁，如果有人知道怎麼做可以教我一下，我可以調整一下。
4. 美股不知道哪邊有資料，有人知道那邊有美股類似證交所這樣一個表有全部股價資料的網站嗎？
5. 我不知道要怎麼判斷最近交易日，所以如果假日用會沒資料。
（暫時先找了一個土炮的方法，目前的連結已經先更新）


巨集內容如下。

抓上市股票：

Private Sub CommandButton1_Click()

'宣告變數
    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
'告訴Excel不要每更新一格就重新計算
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
'將現在的工作表設為資料表
    Set DataSheet = ActiveSheet
    qurl = "http://www.tse.com.tw/exchangeReport/MI_INDEX?response=csv&date=" + Range("A9") + Range("A10") + Range("A11") + "&type=ALLBUT0999"
    Range("B:Z").Clear
'抓取資料
QueryQuote:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
                .RefreshStyle = xlInsertEntireRows
                .Delete
            End With

'讓Excel重新活回來，讓資料能夠顯示
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
'切數據
        Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True
End Sub

抓上櫃股票：

Private Sub CommandButton1_Click()

'宣告變數
    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
'告訴Excel不要每更新一格就重新計算
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
'將現在的工作表設為資料表
    Set DataSheet = ActiveSheet
    qurl = "http://www.tpex.org.tw/web/stock/aftertrading/otc_quotes_no1430/stk_wn1430_print.php?l=zh-tw&d=" + Range("A9") + "/" + Range("A10") + "/" + Range("A11") + "&se=EW&s=0,asc,0"
    Range("B:Z").Clear
'抓取資料
QueryQuote:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
                .RefreshStyle = xlInsertEntireRows
                .Delete
            End With
  
'讓Excel重新活回來，讓資料能夠顯示
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
End Sub

抓興櫃股票：

Private Sub CommandButton1_Click()
'宣告變數
    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
'告訴Excel不要每更新一格就重新計算
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
'將現在的工作表設為資料表
    Set DataSheet = ActiveSheet
    qurl = "http://www.gretai.org.tw/storage/emgstk/ch/new.csv"
    Range("B:Z").Clear
'抓取資料
QueryQuote:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("B1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
                .RefreshStyle = xlInsertEntireRows
                .Delete
            End With

'讓Excel重新活回來，讓資料能夠顯示
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
'切數據
        Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
        TrailingMinusNumbers:=True
End Sub

Excel：樞紐分析表，資料分組

用樞紐分析表快速把資料分組的方式。

例如把1~5000，5001~10000，10001~15000....每個區間的人數，快速統計出來。

方式如下：
 

Excel：VBA，將函數回傳值改為變數

Sub addlog()
'
' addlog 巨集
' 自動貼即時
'
' 快速鍵: Ctrl+Shift+A
'
    Rows("3:3").Select
    Selection.Copy
    Dim x As Long
    x = Evaluate("=counta(A:A)")
'用Evaluate回傳=counta(A:A)的結果，並將值定義為變數x，在此處為3
    y = x + 2
    Rows(y & ":" & y).Select
'選擇第5行（3+2=5）
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

研究半天，人生第一個自己寫成功的VBA。

Excel：巢狀函數將字串強制回傳為數值

搜尋值的資料型態必須與表格資料型態相同才能正確比對。

像是LEFT、MID等函數得到的是字串型態，所以加上--強制轉成數值，才能與表格中的資料型態一致。


例如原本這樣的函數公式會回傳錯誤值「#N/A」：

=VLOOKUP(MID(A1,SEARCH("(",A1)+1,4),C:D,2,0)

但如果加上「--」就可以正確回傳：

=VLOOKUP(--MID(A1,SEARCH("(",A1)+1,4),C:D,2,0)

Exce：不等於<>，以整頁及格式化設定

=(A1<>"")

則代表：如果A1不等於空字串，則為TURE

=OR(($I2<6)*($I2<>""),($I2="X"))

則代表：如果I2小於6且不等於空字串，或I2為X，則為TURE

另外在格式化條件裡面這樣設定，就可以不用一條一條設定了：