總幹事耕讀筆記- 日本 ありがとうございました

有人反應看不懂，我把第三點露的更清楚給您看。
1. EXCEL 檔案所需設定活頁簿（下圖紅色標示）
2. 活頁簿 UI所需欄位（下圖藍色標示），另中間的設定將於後續幾張圖中標示。


第1區塊設定說明
以函數VLOOKUP 抓取定義於第2區塊中不同資料網址變數


公式說明如下


第2區塊 不同資料所需網址的相關定義


第3區塊 計算十項指標，我利用EXCEL的一般功能，只有一個DMAX() 函數比較難些。另別忘了在第3區塊最右邊那些設定的中文字詞。




那兩個執行按鈕部份，請參照前一篇說明製作吧。
多筆執行所需活頁簿 LIST 之欄位（下圖紅色標示）。你只要將你要大量抓取之公司依續放於A2、A3、A4、A5………………….，就可以執行多筆功能。


以下開始進入重頭戲，就是程式碼更改部份。
程式一：抓取某一股票各資料之程式，所需網址資料參考前面第2區塊所定義。
= = = = = = = = = = = = =
Sub Get_D_Y()
'抓取某一股票各資料之程式
Dim stockid '定義股票代號
stockid = Sheets("UI").Range("A2").Value '股票代號位於活頁簿 UI 的 A2
type1 = Sheets("UI").Range("D2").Value '股票資料不同則網頁不同,以此代表,位於活頁簿 UI 的 D2
type2 = Sheets("UI").Range("E2").Value '股票資料不同則網頁不同,以此代表,位於活頁簿 UI 的 E2
tables = Sheets("UI").Range("C2").Value '股票資料不同則位於網頁不同table,以此代表,位於活頁簿 UI的 C2

'以下是抓取網頁時須傳入之網址,將其定義為字串參數,依不同類型串接起來;固定的一段加上有變化的3個
    myurl = "URL;http://dj.mybank.com.tw/z/zc/" & type1 & stockid & type2

    Sheets("TMP").Select '選取活頁簿
    Cells.Select '選取全部欄位
    Selection.Delete Shift:=xlUp '刪除所有欄位. 以避免抓資料有混淆
    Range("A1").Select '選定 A1
'以下就是EXCEL抓取網頁的標準動作,只是connection 改由參數myurl傳入網址,webtables 由參數tables傳入數值
    With ActiveSheet.QueryTables.Add(Connection:=myurl, Destination:=Range("A1"))
        .Name = "5&stockid=2330_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = tables
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .Refresh BackgroundQuery:=False
      End With
    End Sub

程式二：將由網頁上抓到活頁簿TMP 之資料搬到相對應活頁簿。
= = = = = = = = = = = = =
Sub MV(web As String)
'將由網頁上抓到活頁簿TMP 之資料搬到相對應活頁簿

    shname2 = Sheets("UI").Range("B2").Value '設定剛才所抓資料之屬性,'位於活頁簿 UI 的 B2
    '以下就是搬移資料,我用錄製的來作. 是可以改成更簡單的code
    Sheets("TMP").Select
    Columns("A:O").Select
    Selection.Copy
    Sheets(shname2).Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub

程式三：用於多筆執行功能，將活頁簿UI 上已算出的分數,放至活頁簿 LIST。
= = = = = = = = = = = = =

Sub MVAA(x)
'將活頁簿UI 上已算出的分數,放至活頁簿 LIST

Dim addrB, addrC, addrD, addrE, addrF, addrG, addrH, addrI, addrJ, addrK, addrL, addrM As String
'定意位置
    addrB = "$B$" & x
    addrC = "$C$" & x
    addrD = "$D$" & x
    addrE = "$E$" & x
    addrF = "$F$" & x
    addrG = "$G$" & x
    addrH = "$H$" & x
    addrI = "$I$" & x
    addrJ = "$J$" & x
    addrK = "$K$" & x
    addrL = "$L$" & x
    addrM = "$M$" & x
'將活頁簿 UI 的分數依續放入活頁簿 LIST 中相對應位置
    Sheets("List").Range(addrB).Value = Sheets("UI").Range("B14").Value
    Sheets("List").Range(addrC).Value = Sheets("UI").Range("F15").Value
    Sheets("List").Range(addrD).Value = Sheets("UI").Range("F16").Value
    Sheets("List").Range(addrE).Value = Sheets("UI").Range("F17").Value
    Sheets("List").Range(addrF).Value = Sheets("UI").Range("F18").Value
    Sheets("List").Range(addrG).Value = Sheets("UI").Range("F19").Value
    Sheets("List").Range(addrH).Value = Sheets("UI").Range("F20").Value
    Sheets("List").Range(addrI).Value = Sheets("UI").Range("F21").Value
    Sheets("List").Range(addrJ).Value = Sheets("UI").Range("F22").Value
    Sheets("List").Range(addrK).Value = Sheets("UI").Range("F23").Value
    Sheets("List").Range(addrL).Value = Sheets("UI").Range("F24").Value
    Sheets("List").Range(addrM).Value = Sheets("UI").Range("F25").Value
End Sub

程式一、二、三 請放置於模組（module）處，此部份你依第一篇錄製巨集那篇即可看到。http://www.wretch.cc/blog/bonddealer/14368237

程式四：下列兩程式為按鈕執行程式，需褡配你為按鈕所取名字（是Name 非caption；Caption 為顯示在按鈕上的字，Caption 可用中文。）。建議你依前一篇所教方法進入編輯此段程式。http://www.wretch.cc/blog/bonddealer/14368321
= = = = = = = = = = = = = = = = = = = = = = = = = =
四之一 多筆執行
= = = = = = = = = = = = =
Private Sub Multi_Click()
'多筆執行
Sheets("UI").Select '確定起始畫面在UI
Dim RNO As Long '定義要抓取資料數參數
Dim addr1 As String '定義資料位置參數

    RNO = Sheets("List").Range("A2").CurrentRegion.Rows.Count '資料數啟始點,在活頁簿list 的A2開始

    For J = 1 To RNO - 1 ' -------->從A2開始跑 RNO列
        addr1 = "$A$" & J + 1 '位置參數
        Set PT1 = Sheets("List").Range(addr1) '資料位置
          Sheets("UI").Range("A2").Value = PT1.Offset(0, 0).Value '將要抓公司股號資料的指標放入A2
            start_Click '呼叫 單筆作業 程式
            MVAA (J + 1) '呼叫 將計算完分數搬至活頁簿 LIST 之程式
    Next J '迴圈之結尾
    Sheets("UI").Select '將畫面再轉回 UI
End Sub

四之二 單筆執行
= = = = = = = = = = = = =

Private Sub Single_Click()
'單筆執行
    Sheets("UI").Select '確定起始畫面在UI
Dim RNO As Long '定義要抓取資料數參數
Dim addr1 As String '定義資料位置參數

    RNO = Range("J1").CurrentRegion.Rows.Count '資料數啟始點,在活頁簿UI 的 J1 開始

    For i = 1 To RNO ' -------->從J1開始跑 RNO 列
        addr1 = "$J$" & i '位置參數
        Set PT = Sheets("UI").Range(addr1) '資料位置
          Sheets("UI").Range("B2").Value = PT.Offset(0, 0).Value '將要抓資料的指標放入B2
        Get_D_Y '呼叫抓資料的程式
        MV ("Y") '呼叫將資料由TMP 搬至該資料所屬位置之程式
    Next i '迴圈之結尾
    Sheets("UI").Select '將畫面再轉回 UI
End Sub