Ptt：Excel抓公開觀測站的數據

A欄放你要的股票代號, 2002, 1301, 2317...

最好抓到前一年就好，這一年的在另外抓～～

Sub Ptt()
Dim Fn As Object
Set Fn = Application.WorksheetFunction
yearstart = 2000
yearend = 2007
tempvalue = 0
For i = 1 To 2
co_id = Cells(i, 1)
For j = yearstart To yearend
 For k = 1 To 4
     yearseason = j & "0" & k
 With ActiveSheet.QueryTables.Add(Connection:= _
     "URL;http://mops.twse.com.tw/nas/t06sa18/" & yearseason & "/A02_" & co_id & "_" & yearseason & ".htm", _
     Destination:=Range("B1"))
     .Name = "PTT"
     .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 = "4"
     .WebPreFormattedTextToColumns = True
     .WebConsecutiveDelimitersAsOne = True
     .WebSingleBlockTextImport = False
     .WebDisableDateRecognition = False
     .WebDisableRedirections = False
     .Refresh BackgroundQuery:=False
 End With
     For l = 1 To 16
         teststring = Fn.Trim(Cells(30 + l, 2))
         test = Mid(teststring, 1, 4)
         If test = "本期淨利" Then
             temp = Cells(30 + l, 3)
             tempvalue = tempvalue + 1
             Sheets("sheet2").Cells(tempvalue, 1) = co_id
             Sheets("sheet2").Cells(tempvalue, 2) = yearseason
             Sheets("sheet2").Cells(tempvalue, 3) = temp
             Exit For
         Else
             temp = ""
         End If
     Next
 ActiveSheet.Range("B:H").Delete
 Next
Next
Next
End Sub

Tags: Excel, Teaching

• 編輯文章
• 此文章網址
• 轉寄此文章
• 目前有0 意見