12
返回列表 上一主題 發帖

[發問] 更新下載速度、存取問題

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 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
複製代碼

TOP

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
12#
發表於 2011-9-25 14:48 | 只看該作者
回復 11# GBKEE

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

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
13#
發表於 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欄資料寫入各代號的列位中
紅字部分 請附範例上來

TOP

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
14#
發表於 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中各代號的列位.

Test.rar (319.53 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 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
複製代碼

TOP

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
16#
發表於 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呢?

TOP

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
17#
發表於 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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
18#
發表於 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
複製代碼

TOP

spermbank

帖子
94 
主題
28 
精華
0 
積分
145 
點名
0  
作業系統
windows 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2011-9-22 
最後登錄
2021-10-18 
19#
發表於 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
讓我在判斷儲存格的時候發生錯誤

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
20#
發表於 2011-9-29 07:13 | 只看該作者
回復 19# spermbank
工作表儲存格裡的函數 =TODAY()

TOP

        靜思自在 : 【行善要及時】行善要及時，功德要持續。如燒開水一般，未燒開之前千萬不要停熄火候，否則重來就太費事了。
12
返回列表 上一主題