| ©«¤l4901 ¥DÃD44 ºëµØ24 ¿n¤À4916 ÂI¦W267  §@·~¨t²ÎWindows 7 ³nÅ骩¥»Office 20xx ¾\ŪÅv150 ©Ê§O¨k ¨Ó¦Û¥x¥_ µù¥U®É¶¡2010-4-30 ³Ì«áµn¿ý2025-10-31 
                
 | 
                
| ¦^´_ 1# leondavinci727 ½Æ»s¥N½XSub activateMacro()
Dim dic As Object, ky, A As Range, r%
Set dic = CreateObject("Scripting.Dictionary")
    Dim com_no As String
        com_no = Worksheets("ÃþD").Range("$K$3").Value
With ActiveSheet.QueryTables("ÃþD")
.Connection = "URL;http://www.twse.com.tw/ch/trading/exchange/BFIAMU/genpage/Report201303/" & com_no & "_F3_1_5.php?chk_date=102/03/26"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebFormatting = xlWebFormattingNone
.WebTables = "8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
r = 35
Do Until Cells(r, 1) = ""
dic(Cells(r, 1).Value) = Range(Cells(r + 1, 1), Cells(r + 1, 1).End(xlToRight)).Value
r = r + 2
Loop
For Each ky In dic.keys
   With Sheets(ky)
   Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
   A.Resize(, UBound(dic(ky), 2)) = dic(ky)
   End With
Next
End Sub
 | 
 |