lalalada

回復  GBKEE

yap 就是這個
另外提供一小段程式碼
可以免去手動輸入日期
反正他也只有一天的資料可以 ...
lalalada 發表於 2012-8-1 13:56

超過三分鐘不能編輯...
我發現日期隨便打抓到的東西都一樣!
所以也不需要特別指定了@@

lalalada

實際上不需要輸入日期引數就可以載入網頁~

另外想請教
.ResultRange(1).End(xlDown).Offset(2).CurrentRegion.Cut .ResultRange(1).End(xlToRight).Offset(, 1)
這兩句是什麼意思?

GBKEE

回復 11# lalalada
所以是只可以察看前一日 或 當日的資料
回復 12# lalalada

.ResultRange-> QueryTablet  查詢傳送來的資料範圍  
.ResultRange(1).->.ResultRange.Cells(1)

vba 的說明及範例
ResultRange 屬性 請參閱套用至範例特定傳回 Range 物件，該物件代表指定查詢表所覆蓋的工作表區域。唯讀。
範例
本範例對第一張查詢表中第一欄的資料進行加總，並在資料範圍下方顯示第一欄資料的總和。
Set c1 = Sheets("sheet1").QueryTables(1).ResultRange.Columns(1)
c1.Name = "Column1"
c1.End(xlDown).Offset(2, 0).Formula = "=sum(Column1)"

HSIEN6001

回復 10# lalalada

參考!參考!~~有誤請糾正我!

我的理解是
.RefreshStyle = xlOverwriteCells        '= xlOverwriteCells '覆蓋原欄位   = xlInsertDeleteCells '插入新資料,原資料右移


所以抓完全頁面之後的應用
Option Explicit
Sub Ex()
    Dim QueryTable_Name As String
    With ActiveSheet
        With .QueryTables.Add(Connection:="URL;http://******", Destination:=Range("A1"))
            QueryTable_Name = .Name
            .RefreshStyle = xlOverwriteCells        '= xlOverwriteCells '覆蓋原欄位   = xlInsertDeleteCells '插入新資料,原資料右移
            .Refresh BackgroundQuery:=False
        End With
        .Names(QueryTable_Name).Delete   '刪除:查詢在工作表所定義的範圍名稱
    End With

'這裡另外剪貼出去,讓檔案各自獨立
Columns("資料範圍").Select
Selection.Cut      '剪下資料的範圍
Workbooks.Add   '新增資料表
Range("A1").Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs

End Sub

GBKEE

回復 10# lalalada
   

  .WebTables = "4,""table2"""

修改9#如下

1. Option Explicit
   
2. Sub 個股交易明細下載()
   
3.     Dim 股票代號 As String, N As Name, i As Integer, T As Date, A
   
4.     Do While 股票代號 = ""
   
5.         股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
   
6.         If 股票代號 = "" Then End
   
7.     Loop
   
8.     T = Time
   
9.     With ActiveSheet
   
10.         .Cells.Clear
    
11.         DoEvents
    
12.         Application.ScreenUpdating = False
    
13.         Application.StatusBar = False
    
14.         With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & 股票代號 & "&FocusIndex=1", Destination:=Range("A1"))
    
15.             .WebFormatting = xlWebFormattingNone
    
16.             .WebTables = "4,""table2"""
    
17.             .Refresh BackgroundQuery:=False
    
18.             If Application.CountA(.ResultRange) = 0 Then
    
19.                 MsgBox "股票代號:" & 股票代號 & " 錯誤 !!!"
    
20.                 [a1].Select
    
21.                 End
    
22.             End If
    
23.             ActiveSheet.Names(.Name).Delete
    
24.         End With
    
25.         i = 2
    
26.         Do
    
27.             .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Select
    
28.              With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & 股票代號 & "&FocusIndex=" & i, Destination:=Selection)
    
29.                 .WebFormatting = xlWebFormattingNone
    
30.                 .WebTables = "table2"
    
31.                 On Error Resume Next
    
32.                 Do
    
33.                      Err.Clear
    
34.                     .Refresh BackgroundQuery:=False
    
35.                 Loop Until Err.Number = 0
    
36.                 On Error GoTo 0
    
37.                 If Application.CountA(.ResultRange) = 0 Then GoTo OUT
    
38.                 .ResultRange(1).EntireRow.Delete
    
39.                 ActiveSheet.Names(.Name).Delete
    
40.                 i = i + 1
    
41.             End With
    
42.         Loop
    
43. OUT:
    
44.         .[a1].Select
    
45.         Application.ScreenUpdating = True
    
46.         .Columns.AutoFit
    
47.         A = CreateObject("WScript.Shell").popup("共下載 " & i & " 頁費時  " & Format(Time - T, "hh:mm分SS秒"), 5, "_" & 股票代號, 48 + 0)
    
48.         Application.StatusBar = "股票代號 [" & 股票代號 & "] 共下載 " & i & "頁 費時 " & Format(Time - T, "HH:MM:SS")
    
49.         For Each N In .Names
    
50.             N.Delete
    
51.         Next
    
52.      End With
    
53. End Sub

複製代碼

lalalada

回復 13# GBKEE
回復 14# HSIEN6001

     感謝兩位的說明!!

sd-jason

請問各位大大：
為什麼我貼上以後，它一直說找不到巨集？
有沒有檔案可以讓我看一下...
感謝 !

sd-jason

各位大大：
我剛剛試完可以囉！
只是這個好像沒有辦法像上次分享的，
自動把所有的股票抓下來，
而需要一個一個去抓，
請問這要修改哪裡....
{:3_57:}

lalalada

回復 18# sd-jason


寫個迴圈就可以囉..
基本上就是
for x = 1 to 10
code=cells(x,1) 'cell是存放股票代碼的儲存格 一開始先打好
'把code代入原程式的"股票代碼"
next

a2305577

回復 10# lalalada


    請問要加到哪裡？這段程式....會比較快嗎？