Board logo

標題: [發問] 更新下載速度、存取問題 [打印本頁]
作者: spermbank    時間: 2011-9-22 20:31     標題: 請問一下巨集中斷、存檔、日期問題

本帖最後由 spermbank 於 2011-9-22 20:33 編輯

1.巨集問題:
   問題:因為要接收DDE資料，但是DDE資料(元大yewwin)不能一次大量下載
            所以我寫了兩個巨集按鈕、分別去更新DDE資料，但是覺得要按兩次巨集按鈕，覺得很麻煩。
   請問:如何使巨集1中斷10秒後(非延遲10秒)、待利用yes.exe(開啟excel自動就會持續更新、但執行巨集沒辦法)更新資料完畢，在繼續執行巨集2呢?

2.存取問題:(這是網路上程式)，另類似諸如此類excel vba有沒有可推薦的書籍。

   問題:在a.workbooks.open 這一行出現語法錯誤，請問我要如何修改??

Private Sub Form_Load()
Set a = CreateObject("excel.application")
sdate = "2007/4/20" '開始日期
edate = "2007/4/21" '終止日期
save_file_name = "C:\test.csv" '存檔檔名

'用excel來存檔
a.Workbooks.Open "http://www.taifex.com.tw/chinese/3/3_1_2dl.asp?syear=" & Year(sdate) & "&smonth=" & Month(sdate) & "&sday=" & Day(sdate) & "&eyear=" & Year(edate) & "&emonth=" & Month(edate) & "&eday=" & Day(edate) & "&COMMODITY_ID="
a.DisplayAlerts = False
a.ActiveWorkbook.SaveAs save_file_name, 6, False '存成csv
'要直接看可以略過關閉的指令!!!
a.quit
Set a = Nothing
Shell "explorer.exe c:\", vbMaximizedFocus
End
End Sub


3.儲存格cells(1,1) ="2000/01/31"日期格式
我要如何利用x,y,z分別捉2000、01、31等三組數字(拿掉/呢?)
作者: GBKEE    時間: 2011-9-22 21:00

回復 1# spermbank
1
  1.   Sub 巨集1()
  2.     '
  3.     '
  4.     Application.OnTime Now + TimeValue("00:00:10"), "巨集2"
  5. End Sub
複製代碼
2   2003版 中找不出錯誤

3  X = Year(Cells(1, 1))
    Y = Month(Cells(1, 1))
   Z = Day(Cells(1, 1))
'''''''''''''''''''''''''
   A = Split(Cells(1, 1), "/")
   X = A(0)
   Y = A(1)
   Z = A(2)
作者: spermbank    時間: 2011-9-23 00:28

1.3解決 感謝大大
可是第二個問題，我還是解決不出來，以下是我的程式碼
我是用excel 2007
Sub Download()

    Set f = CreateObject("excel.application")
   
    save_file_name = "C:\test.csv" '存檔檔名
   
    s = "2002"
    i = "00"
    j = "1"
    k = "2010"
    m = "11"
    n = "31"
    o = "2011"
   
    '用excel來存檔
    f.Workbooks.Open "http://ichart.finance.yahoo.com/table.csv?s=" & s ".TW&a=" & i "&b=" & j "&c=" & k "&d=" & m "&e=" & n "&f=" & o "&g=d&ignore=.csv"
    'http://ichart.finance.yahoo.com/table.csv?s=2002.TW&a=00&b=1&c=2010&d=11&e=31&f=2011&g=d&ignore=.csv
    f.DisplayAlerts = False
    f.ActiveWorkbook.SaveAs save_file_name, 6, False '存成csv
    '要直接看可以略過關閉的指令!!!
    f.Quit
    Set f = Nothing
    Shell "explorer.exe c:\", vbMaximizedFocus
    End
   
End Sub
作者: GBKEE    時間: 2011-9-23 07:42

回復 3# spermbank
少一個連接符號 &
  f.Workbooks.Open "http://ichart.finance.yahoo.com/table.csv?s=" & s ".TW&a=" & i "&b=" & j "&c=" & k "&d=" & m "&e=" & n "&f=" & o  "&g=d&ignore=.csv

F.Workbooks.Open "http://ichart.finance.yahoo.com/table.csv?s=" & s & ".TW&a=" & i & "&b=" & j & "&c=" & k & "&d=" & m & "&e=" & n & "&f=" & o & "&g=d&ignore=.csv"
作者: spermbank    時間: 2011-9-23 10:41

真的很感謝大大，自己看這行程式已經看過好幾個小時，都沒有發現，如今程式能繼續往下寫，真的很開心，超級開心，謝謝。
作者: spermbank    時間: 2011-9-24 15:41     標題: 更新下載速度、存取問題

本帖最後由 spermbank 於 2011-9-24 15:43 編輯

1:執行 [所有歷史股價按鈕] 存成.csv檔，發現存取檔案速度非常慢
  問:如何修改程式提升下載速度?

2:如何讀取代號1101.csv第1欄所有日期(data)，寫入excel中的sheet2的第1列中，並且讀取所有*.csv檔案中的第5欄(close)的資料，依序對照檔名與第1欄中的代號將第5欄資料寫入各代號的列位中.
  此問題有爬文尋找相關問題試寫，可是還是寫不出來，想請問各位大大。

  PS:附加:附件text1 PS:還是小學生，可請大大寫完，程式碼用貼，謝謝。
作者: GBKEE    時間: 2011-9-24 16:36

回復 1# spermbank
要開關 1298個檔案 速度快不了
  1. Sub 按鈕3_Click()
  2.     With ThisWorkbook.Sheets("Sheet1")
  3.         .Range("H" & 11).Formula = "更新中..."
  4.         ii = .Cells(6, 6) - 1 '起始月
  5.         j = .Cells(7, 6) '起始日
  6.         k = .Cells(5, 6) '起始年
  7.         m = .Cells(6, 8) - 1 '終止月
  8.         n = .Cells(7, 8) '終止日
  9.         o = .Cells(5, 8) '終止年
  10.         h = .Cells(9, 6) '存檔位置
  11.         Application.ScreenUpdating = False       '停止螢幕更新
  12.         For i = 2 To Application.CountA(.Range("A:A")) '欄位有值範圍計算
  13.             symbol = .Cells(i, 1)
  14.             save_file_name = h & symbol & ".csv" '存檔檔名
  15.             If .Range("C" & i).Formula = "市" Then
  16.                 '用excel來存檔
  17.                 Workbooks.Open "http://ichart.finance.yahoo.com/table.csv?s=" & symbol & ".TW&a=" & ii & "&b=" & j & "&c=" & k & "&d=" & m & "&e=" & n & "&f=" & o & "&g=d&ignore=.csv"
  18.             Else
  19.                 Workbooks.Open "http://ichart.finance.yahoo.com/table.csv?s=" & symbol & ".TWO&a=" & ii & "&b=" & j & "&c=" & k & "&d=" & m & "&e=" & n & "&f=" & o & "&g=d&ignore=.csv"
  20.             End If
  21.             With ActiveWorkbook   '檔案開啟後成為作用中的活頁簿
  22.                 .SaveAs save_file_name, 6, False '存成csv
  23.                 .Close False
  24.             End With
  25.         Next
  26.         .Range("H" & 11).Formula = "更新結束"
  27.     End With
  28.     Application.ScreenUpdating = True     '螢幕更新
  29. End Sub
複製代碼
作者: spermbank    時間: 2011-9-24 18:26

本帖最後由 spermbank 於 2011-9-24 18:30 編輯

回復 7# GBKEE


  大大你好:
         附加檔案是我在網路上找到的類似檔案，發現它執行的速度，的確快很多，給您參考一下。
  看看是否有一些靈感，可以讓程式速度變得快一些(可是此檔尚未開放巨集程式碼)。
        還有再執行此程式時，出現一個視窗"聯絡伺服器以取得資訊"，是否可以不顯示或修改程式，因為除了拖慢excel執行速度之外，讓電腦無法從事其他工作。
另外:
       可否請大大協助解決第二個問題，謝謝。

       真的很謝謝大大回應我^^
作者: GBKEE    時間: 2011-9-24 20:31

本帖最後由 GBKEE 於 2011-9-24 20:34 編輯

回復 8# spermbank
自己測試看看
  1. Sub 按鈕3_Click()
  2.     Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
  3.     With ThisWorkbook.Sheets("Sheet1")
  4.         .Range("H" & 11).Formula = "更新中..."
  5.         ii = .Cells(6, 6) - 1 '起始月
  6.         j = .Cells(7, 6) '起始日
  7.         k = .Cells(5, 6) '起始年
  8.         m = .Cells(6, 8) - 1 '終止月
  9.         n = .Cells(7, 8) '終止日
  10.         o = .Cells(5, 8) '終止年
  11.         h = .Cells(9, 6) '存檔位置
  12.         For i = 2 To Application.CountA(.Range("A:A")) '欄位有值範圍計算
  13.             symbol = .Cells(i, 1)
  14.             save_file_name = h & symbol & ".csv" '存檔檔名
  15.             If .Range("C" & i).Formula = "市" Then
  16.                 '用excel來存檔
  17.                 myURL = "http://ichart.finance.yahoo.com/table.csv?s=" & symbol & ".TW&a=" & ii & "&b=" & j & "&c=" & k & "&d=" & m & "&e=" & n & "&f=" & o & "&g=d&ignore=.csv"
  18.             Else
  19.                 myURL = "http://ichart.finance.yahoo.com/table.csv?s=" & symbol & ".TWO&a=" & ii & "&b=" & j & "&c=" & k & "&d=" & m & "&e=" & n & "&f=" & o & "&g=d&ignore=.csv"
  20.             End If
  21.             WinHttpReq.Open "GET", myURL, False
  22.             WinHttpReq.Send        '
  23.             myURL = WinHttpReq.ResponseBody
  24.             If WinHttpReq.Status = 200 Then
  25.                 With CreateObject("ADODB.Stream")
  26.                     .Open
  27.                     .Type = 1
  28.                     .Write WinHttpReq.ResponseBody
  29.                     .SaveToFile (save_file_name)
  30.                     .Close
  31.                 End With
  32.             End If
  33.         Next
  34.         .Range("H" & 11).Formula = "更新結束"
  35.     End With
  36. End Sub
複製代碼
作者: spermbank    時間: 2011-9-25 03:09

本帖最後由 spermbank 於 2011-9-25 03:11 編輯

回復 9# GBKEE

速度快超多，大概8-10分鐘，1千多筆洗個澡就跑完^^ 真的是十分感謝大大
可是1341筆中只下載1255筆，不知道是代號重複或miss或網頁無此資料。我再來找找看錯誤在哪裡
另外:

此程式為再第C欄位中有"櫃"這字眼，就刪除該欄的第A至C列
可是跑此程式發現，卻需要執行多次，有"櫃"這字眼的第A至C列才會被刪除
可是程式不是執行一次就可以成功，卻要執行多次才可。
實在是找不出錯誤，不過我懷疑是不是我不熟悉delet或select的限制，還是速度問題
請大大指教。

(以下是程式碼，另有附加檔案)
Sub 按鈕6_Click()

    Sheets("Sheet1").Select
    x = Application.WorksheetFunction.CountA(Range("A:A")) '欄位有值範圍計算
    For i = 2 To x
        If Range("C" & i).Formula = "櫃" Then
           Range("A" & i, "D" & i).Select
          Selection.Delete Shift:=xlUp
        End If
    Next
End Sub
作者: GBKEE    時間: 2011-9-25 06:34

回復 10# spermbank
  1. Sub 按鈕6_Click()
  2.     Dim Rng As Range
  3.     Sheets("Sheet1").Select
  4.     X = Application.WorksheetFunction.CountA(Range("A:A")) '欄位有值範圍計算
  5.     For i = X To 2 Step -1
  6.         If Range("C" & i).Formula = "櫃" Then
  7.                 Range("A" & i, "C" & i).Delete Shift:=xlUp
  8.         End If
  9.     Next
  10. End Sub
  11. Sub 按鈕6_Click()
  12.     Dim Rng As Range
  13.     Sheets("Sheet1").Select
  14.     X = Application.WorksheetFunction.CountA(Range("A:A")) '欄位有值範圍計算
  15.     For i = 2 To X
  16.         If Range("C" & i).Formula = "櫃" Then
  17.             If Rng Is Nothing Then
  18.                 Set Rng = Range("A" & i, "C" & i)
  19.             Else
  20.                 Set Rng = Union(Rng, Range("A" & i, "C" & i))
  21.             End If
  22.         End If
  23.     Next
  24.     Rng.Delete Shift:=xlUp
  25. End Sub
複製代碼
作者: spermbank    時間: 2011-9-25 14:48

回復 11# GBKEE

感謝大大，讓我的程式又可以繼續往下寫。
關於捉歷史股價沒捉到的部分，經過一筆一筆的比對，確定是網站無此資料。
另，捉歷史股價方面程式有點不懂，但是關於刪除有關"櫃"的列位
為什麼我那樣子的寫法不行呢?

2:如何讀取代號1101.csv第1欄所有日期(data)，寫入excel中的sheet2的第1列中，並且讀取所有*.csv檔案中的第5欄(close)的資料，依序對照檔名與第1欄中的代號將第5欄資料寫入各代號的列位中.
  此問題有爬文尋找相關問題試寫，可是還是寫不出來，請求大大幫忙。
作者: GBKEE    時間: 2011-9-25 18:11

回復 12# spermbank
問題1 : 欄 或 列 的刪除.  需由 下往上  刪除.  由 上往下  刪除 會有漏網之魚
  1. for i=1 to 10      '由 上往下  刪除
  2. cells(i,1).Delete Shift:=xlUp  
  3. '例=1 -> 下方儲存格上移   cells(2,1)會上升為cells(1,1) 漏網掉
  4. '例=5 -> 下方儲存格上移   cells(6,1)會上升為cells(5,1) 漏網掉
  5. next
複製代碼

問題2: 如何讀取代號1101.csv第1欄所有日期(data)，寫入excel中的sheet2的第1列中，並且讀取所有*.csv檔案中的第5欄(close)的資料，依序對照檔名與第1欄中的代號將第5欄資料寫入各代號的列位中
紅字部分 請附範例上來
作者: spermbank    時間: 2011-9-26 01:36

本帖最後由 spermbank 於 2011-9-26 01:41 編輯

回復 13# GBKEE


    問題2: 如何讀取代號1101.csv第1欄所有日期(data)，寫入excel中的sheet2的第1列中，並且讀取所有*.csv檔案中的第5欄(close)的資料，依序對照檔名與第1欄中的代號將第5欄資料寫入各代號的列位中

    紅字部分 請附範例上來

附檔:excel中Sheet2為想要達成的範例，輸入的資料為data資料夾中部分的*.csv
        下載下來的*.csv，可能與Sheet2的代號不一致，因為網路下載的資料不全
        所以想要從下載下來的*.csv與Sheet2代號核對後，並把所有*.csv的第(Close)欄資料轉置到Sheet2中各代號的列位.
作者: GBKEE    時間: 2011-9-26 09:14

回復 14# spermbank
  1. Sub 按鈕7_Click()
  2.     Dim TheCsv As String, ThePath As String, OpCsv As Workbook, CsvRange As Range, TheRow As Variant
  3.     ThePath = Sheets("Sheet1").Range("F9")                                          'D:\data\   請加上"\"
  4.     TheCsv = Dir(ThePath & "*.CSV")                                                 '傳回符合的第一個檔案名稱
  5.     If TheCsv = "" Then MsgBox ThePath & " 沒有 CSV檔案": Exit Sub
  6.     Application.ScreenUpdating = False
  7.     With Sheets("Sheet2")
  8.         If .[C1] <> "" Then .Range(.[C1], .[C1].End(xlToRight).End(xlDown)) = ""    '清空資料
  9.         Do While TheCsv <> ""
  10.             Set OpCsv = Workbooks.Open(ThePath & TheCsv)                            '打開 Csv
  11.             If .[C1] = "" Then                                                      '導入日期
  12.                 Set CsvRange = OpCsv.Sheets(1).Range("A:A").SpecialCells(xlCellTypeConstants).Offset(1) '設定範圍
  13.                 'SpecialCells ->特殊儲存格 ,參數(xlCellTypeConstants->包含常數的儲存格
  14.                 .[C1].Resize(, CsvRange.Rows.Count) = Application.Transpose(CsvRange)   '轉置-> Application.Transpose(範圍)
  15.             End If
  16.             TheRow = Replace(UCase(TheCsv), ".CSV", "")                                 'Replace ->替換文字
  17.             Set TheRow = .Range("A:A").Find(TheRow, LOOKAT:=xlWhole)                    '尋找 *.CSV 在Sheets("Sheet2")的位置
  18.             If Not TheRow Is Nothing Then                                               '找到 *.CSV 在Sheets("Sheet2")的位置
  19.                 Set CsvRange = OpCsv.Sheets(1).Columns(5).SpecialCells(xlCellTypeConstants).Offset(1)  '設定*.csv檔案中的第5欄(close)的資
  20.                 TheRow.Offset(, 2).Resize(, CsvRange.Rows.Count) = Application.Transpose(CsvRange)
  21.             End If
  22.             OpCsv.Close False
  23.             TheCsv = Dir
  24.         Loop
  25.     End With
  26.     Application.ScreenUpdating = True
  27. End Sub
複製代碼
作者: spermbank    時間: 2011-9-26 23:54

本帖最後由 spermbank 於 2011-9-27 00:23 編輯

回復 15# GBKEE

大大謝謝你，程式能順利跑，哈哈，:$
可是發現一個問題，讀取一個csv就會開啟一個excel檔案，導致工作列Excel過多會爆掉，
程式大概可以5分鐘跑完，跑完就恢復正常，還可以等待。
可是是不是有辦法解決這個問題呢??

另外:
12.              Set CsvRange = OpCsv.Sheets(1).Range("A:A").SpecialCells(xlCellTypeConstants).Offset(1) '設定範圍
雖然我看不懂後面的設定，但是可不可以改成
12.              Set CsvRange = OpCsv.Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants).Offset(1) '設定範圍
另外:
                Set CsvRange = OpCsv.Sheets(1).Columns(6).SpecialCells(xlCellTypeConstants).Offset(1)  '設定*.csv檔案中的第6欄(Volume)的資

                TheRow.Offset(, 2).Resize(, CsvRange.Rows.Count) = Application.Transpose(CsvRange)

要怎麼先把第6欄(Volume)所有值都先除以1000再存入Sheet2呢?
作者: spermbank    時間: 2011-9-27 03:13

x = Application.WorksheetFunction.CountA(Range("A:A")) '欄位有值範圍計算
    Dim AA(2000, 4)
    For i = 2 To x
        AA(i, 1) = (Cells(i, 3) + Cells(i, 4) + Cells(i, 5) + Cells(i, 6) + Cells(i, 7)) / 5
        AA(i, 2) = Application.WorksheetFunction.Average(Range("A" & i, "V" & i))  '20日-20個儲存格中的數值平均
        AA(i, 3) = Application.WorksheetFunction.Average(Range("A" & i, "BJ" & i)) '60日
        AA(i, 4) = Application.WorksheetFunction.Average(Range("A" & i, "DR" & i)) '120日
    Next

       想做平均值，可是發現只有A(i,1)的數值對
       另外A(i,2)、A(i,3)、A(i,4)的數值都是錯的
       可否請大大幫我解BUG
作者: GBKEE    時間: 2011-9-27 10:45

本帖最後由 GBKEE 於 2011-9-27 10:58 編輯

回復 16# spermbank
可以改成           Set CsvRange = OpCsv.Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants).Offset(1)
Range ("A:A") =>Columns("A:A")  單欄 Columns(1)
Range ("A:B") >= Columns("A:B")   
要怎麼先把第6欄(Volume)所有值都先除以1000再存入Sheet2呢?
AR = Application.Transpose(CsvRange) ->陣列從儲存格導入值時 每一維度的下限都是從1 開始  ->For i = 1 To UBound(AR)
  1. AR = Application.Transpose(CsvRange)
  2. For i = 1 To UBound(AR)
  3. AR(i) = AR(i) / 1000
  4. Next
  5. TheRow.Offset(, 2).Resize(, CsvRange.Rows.Count) = AR
複製代碼
回復 17# spermbank
  1. Sub Ex()
  2.     Dim x As Double, i As Double, AA()
  3.     x = Application.WorksheetFunction.CountA(Range("A:A")) '欄位有值範圍計算
  4.     ReDim AA(2 To x, 1 To 4)    '2 To x-> 第一維 指定從 2 到 X
  5.                                 '1 To 4-> 第二維 指定從 1 到 4
  6.     For i = 2 To x              '配合陣列維度的上下限
  7.         With Application
  8.         'With Application.WorksheetFunction                  '正統寫法
  9.             AA(i, 1) = .Sum(Cells(i, 3).Resize(, 5)) / 5
  10.             AA(i, 2) = .Average(Range("A" & i).Resize(, 20))  '20日-20個儲存格中的數值平均
  11.             AA(i, 3) = .Average(Range("A" & i).Resize(, 60))  '60日
  12.             AA(i, 4) = .Average(Range("A" & i).Resize(, 120)) '120日
  13.         End With
  14.     Next
  15. End Sub
  16. Sub Ex1()
  17.     x = Application.WorksheetFunction.CountA(Range("A:A")) '欄位有值範圍計算
  18.     Dim AA(2000, 3)     '2000-> 第一維 0-2000 共20001個
  19.                         '3   -> 第二維 0-3    共4個
  20.     For i = 2 To x
  21.         AA(i - 2, 0) = (Cells(i, 3) + Cells(i, 4) + Cells(i, 5) + Cells(i, 6) + Cells(i, 7)) / 5
  22.         AA(i - 2, 1) = Application.WorksheetFunction.Average(Range("A" & i & ": V" & i)) '20日-20個儲存格中的數值平均
  23.         AA(i - 2, 2) = Application.WorksheetFunction.Average(Range("A" & i & ": BJ" & i)) '60日
  24.         AA(i - 2, 3) = Application.WorksheetFunction.Average(Range("A" & i & ": DR" & i)) '120日
  25.     Next
  26. End Sub
複製代碼
作者: spermbank    時間: 2011-9-29 03:27

大大妳好:
舉例:
儲存格 = NOW()  顯示當日日期 2011/9/29  03:19:06 AM
有什麼函式可以 顯示當日 2011/9/29 而不是用    Selection.NumberFormatLocal = "yyyy/m/d"

因為我要寫判斷儲存格的日期，但是多了03:19:06 AM
讓我在判斷儲存格的時候發生錯誤
作者: GBKEE    時間: 2011-9-29 07:13

回復 19# spermbank
工作表儲存格裡的函數 =TODAY()



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)