123
返回列表 上一主題 發帖

[發問] 請問如果有一個股票資料庫，如何使用vba…

gkld

帖子
44 
主題
7 
精華
0 
積分
51 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2012-11-18 
最後登錄
2022-8-6 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-12-26 22:04 | 只看該作者

[發問] 請問如果有一個股票資料庫，如何使用vba…

請問 如果我有一個股票的資料庫，裡面檔名是A11220070102ALL_1.csv、A11220070103ALL_1.csv、A11220070104ALL_1.csv ……等，代表不同日期2007/01/02、2007/01/03、2007/01/04的股票資料，
該資料庫裡有非常多筆.csv檔，每個檔案打開
如圖
現在我想要從這個資料庫內整裡出不同日期的歷史股價，格式如圖
請問如何用vba寫出來了呢？救救我吧~謝謝大家~
收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-12-27 09:44 | 只看該作者
回復 1# gkld
ActiveSheet  '作用中的工作表
是為圖2 中 造紙類指數
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ex_Path As String, Ex_File As String, Ex_Date As String, Ex_Wb As Workbook
  4.     Ex_Path = "資料夾路徑\"                         '******修改它********
  5.     Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  6.     If Ex_File = "" Then
  7.         MsgBox "沒有 A112*ALL_1.csv"
  8.         Exit Sub
  9.     End If
  10.     Application.ScreenUpdating = False
  11.     Do While Ex_File <> ""
  12.         Ex_Date = Replace(Ex_File, "A112", "")                     '消除檔名中"A112"
  13.         Ex_Date = Replace(Ex_Date, "ALL_1.csv", "")                '消除檔名中"ALL_1.csv"
  14.         Ex_Date = DateSerial(Mid(Ex_Date, 1, 4), Mid(Ex_Date, 5, 2), Mid(Ex_Date, 7, 2)) '帶入日期
  15.         With ActiveSheet                                            '作用中的工作表
  16.             Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 A11220070102ALL_1.csv.....
  17.             .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Ex_Date  '日期輸入
  18.             .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("A:A").Find(.Range("B1"), lookat:=xlWhole).Offset(, 1)
  19.             '**** 作用中的工作表.Range("B1") 為查詢指數的類別  *********
  20.             Ex_Wb.Close                                             '關閉 A11220070102ALL_1.csv.....
  21.         End With
  22.         Ex_File = Dir                                               '下一個"A112*ALL_1.csv"
  23.     Loop
  24.     Application.ScreenUpdating = True
  25.     MsgBox "OK"
  26. End Sub
複製代碼

TOP

gkld

帖子
44 
主題
7 
精華
0 
積分
51 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2012-11-18 
最後登錄
2022-8-6 

論壇贊助勳章
3#
發表於 2012-12-27 12:52 | 只看該作者
回復 2# GBKEE


    感謝…版大，現在正在上班中…;P

回家再來試試看~

TOP

gkld

帖子
44 
主題
7 
精華
0 
積分
51 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2012-11-18 
最後登錄
2022-8-6 

論壇贊助勳章
4#
發表於 2012-12-27 13:02 | 只看該作者
回復 3# gkld


    另外，最近自已上網看了一些有關vba的簡單教學，發現這真是一個很實用的工具

      其應用範圍真的很廣泛。
      
      想請教版大…，如果想要學習的話，有推薦的書單嗎？

TOP

gkld

帖子
44 
主題
7 
精華
0 
積分
51 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2012-11-18 
最後登錄
2022-8-6 

論壇贊助勳章
5#
發表於 2012-12-27 14:46 | 只看該作者
回復 4# gkld


    請問板大：
我跑出來的結果是，如圖

我有將第18行程式碼改成如下，主要是為了抓取資料庫中每個csv的range("b12")值

       .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("A:A").Find(.Range("B12"), lookat:=xlWhole).Offset(, 1)
      
不曉得錯在哪兒？求助板大指導。感恩~

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2012-12-27 16:06 | 只看該作者
回復 5# gkld
主要是為了抓取資料庫中每個csv的range("b12")值  
  1. .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("B12")
複製代碼

TOP

gkld

帖子
44 
主題
7 
精華
0 
積分
51 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2012-11-18 
最後登錄
2022-8-6 

論壇贊助勳章
7#
發表於 2012-12-27 20:39 | 只看該作者
回復 6# GBKEE

奇怪~出來的結果應該是會取到每個csv的range("b12")，怎麼出來還是不對？？

附件是我的資料庫 上市.part1.rar (1 MB) 上市.part2.rar (634.63 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兔年全勤獎章
8#
發表於 2012-12-27 21:07 | 只看該作者
回復 7# gkld
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ex_Path As String, Ex_File As String, Ex_Date As String, Ex_Wb As Workbook
  4.     Dim Rng As Range
  5.     Ex_Path = "資料夾路徑\"                         '******修改它********
  6.     Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  7.     If Ex_File = "" Then
  8.         MsgBox "沒有 A112*ALL_1.csv"
  9.         Exit Sub
  10.     End If
  11.     Application.ScreenUpdating = False
  12.     Do While Ex_File <> ""
  13.         Ex_Date = Replace(Ex_File, "A112", "")                     '消除檔名中"A112"
  14.         Ex_Date = Replace(Ex_Date, "ALL_1.csv", "")                '消除檔名中"ALL_1.csv"
  15.         Ex_Date = DateSerial(Mid(Ex_Date, 1, 4), Mid(Ex_Date, 5, 2), Mid(Ex_Date, 7, 2)) '帶入日期
  16.         With ActiveSheet                                            '作用中的工作表
  17.             Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 A11220070102ALL_1.csv.....
  18.             '************************************************
  19.             .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Ex_Date  '日期輸入
  20.             If Ex_Wb.Sheets(1).Range("B12") <> "" Then
  21.                 .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("B12")
  22.             Else
  23.                 .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = "---"   '**沒有資料
  24.                 '**** 作用中的工作表.Range("B1") 為查詢指數的類別  *********
  25.             End If
  26.             '************************************************
  27.             Ex_Wb.Close False                                       '關閉 A11220070102ALL_1.csv.....
  28.         End With
  29.         Ex_File = Dir                                               '下一個"A112*ALL_1.csv"
  30.     Loop
  31.     Application.ScreenUpdating = True
  32.     MsgBox "OK"
  33. End Sub
複製代碼

TOP

gkld

帖子
44 
主題
7 
精華
0 
積分
51 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2012-11-18 
最後登錄
2022-8-6 

論壇贊助勳章
9#
發表於 2012-12-28 21:43 | 只看該作者
回復 8# GBKEE

今天回來測試，結果沒問題~

感謝板大鼎力相助

接著自已就可以簡單地去變換相抓取的儲存格了!!:D

TOP

gkld

帖子
44 
主題
7 
精華
0 
積分
51 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2012-11-18 
最後登錄
2022-8-6 

論壇贊助勳章
10#
發表於 2012-12-28 23:25 | 只看該作者
回復 9# gkld
再請教一個問題，我例用板大教的方式，跑出第一個1101台泥工作表 ，程式碼如下：
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ex_Path As String, Ex_File As String, Ex_Date As String, Ex_Wb As Workbook
  4.     Dim Rng As Range
  5.     Ex_Path = "C:\Documents and Settings\gkld\桌面\my kp\資料庫\上市\"                         '******修改它********
  6.     Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  7.     If Ex_File = "" Then
  8.         MsgBox "沒有 A112*ALL_1.csv"
  9.         Exit Sub
  10.     End If
  11.     Application.ScreenUpdating = False
  12.     Range("a1:ag65536").Clear '消除每一行資料
  13.     Do While Ex_File <> ""
  14.         Ex_Date = Replace(Ex_File, "A112", "")                     '消除檔名中"A112"
  15.         Ex_Date = Replace(Ex_Date, "ALL_1.csv", "")                '消除檔名中"ALL_1.csv"
  16.         Ex_Date = DateSerial(Mid(Ex_Date, 1, 4), Mid(Ex_Date, 5, 2), Mid(Ex_Date, 7, 2)) '帶入日期
  17.         With ActiveSheet                                            '作用中的工作表
  18.             Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 A11220070102ALL_1.csv.....
  19.             '************************************************
  20.             .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Ex_Date  '日期輸入
  21.             If Ex_Wb.Sheets(1).Range("B3") <> "" Then
  22.                 .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find("台泥", lookat:=xlWhole).Offset(, 7)
  23.                 .Cells(.Rows.Count, "e").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find("台泥", lookat:=xlWhole).Offset(, 4)
  24.                 .Cells(.Rows.Count, "f").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find("台泥", lookat:=xlWhole).Offset(, 5)
  25.                 .Cells(.Rows.Count, "g").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find("台泥", lookat:=xlWhole).Offset(, 6)
  26.                 .Cells(.Rows.Count, "i").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find("台泥", lookat:=xlWhole).Offset(, 1)
  27.                     
  28.             Else
  29.                 .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = "---"   '**沒有資料
  30.                 .Cells(.Rows.Count, "e").End(xlUp).Offset(1) = "---"   '**沒有資料
  31.                 .Cells(.Rows.Count, "f").End(xlUp).Offset(1) = "---"   '**沒有資料
  32.                 .Cells(.Rows.Count, "g").End(xlUp).Offset(1) = "---"   '**沒有資料
  33.                 .Cells(.Rows.Count, "i").End(xlUp).Offset(1) = "---"   '**沒有資料
  34.                 '**** 修改作用中的工作表.Range("B1") 為查詢指數的類別  *********
  35.             End If
  36.             '************************************************
  37.             Ex_Wb.Close False                                       '關閉 A11220070102ALL_1.csv.....
  38.         End With
  39.         Ex_File = Dir                                               '下一個"A112*ALL_1.csv"
  40.     Loop
  41.     Application.ScreenUpdating = True
  42.     MsgBox "OK"
  43. End Sub
複製代碼
後來，我想在新增好幾個工作表，如1102亞泥；1103嘉泥；…等一直到1110東泥，共7個工作表

程式碼如下：
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ex_Path As String, Ex_File As String, Ex_Date As String, Ex_Wb As Workbook
  4.     Dim Rng As Range
  5.     Ex_Path = "C:\Documents and Settings\gkld\桌面\my kp\資料庫\上市\"                         '******修改它********
  6.     Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  7.     If Ex_File = "" Then
  8.         MsgBox "沒有 A112*ALL_1.csv"
  9.         Exit Sub
  10.     End If
  11.     Application.ScreenUpdating = False
  12.     Range("a1:ag65536").Clear '消除每一行資料
  13.     For i = 1 To 7
  14.     If i = 1 Then Name = "台泥"
  15.     End If
  16.     If i = 2 Then Name = "亞泥"
  17.     End If
  18.     If i = 3 Then Name = "嘉泥"
  19.     End If
  20.     If i = 4 Then Name = "環泥"
  21.     End If
  22.     If i = 5 Then Name = "幸福"
  23.     End If
  24.     If i = 6 Then Name = "信大"
  25.     End If
  26.     If i = 7 Then Name = "東泥"
  27.     End If
  28.     Do While Ex_File <> ""
  29.         Ex_Date = Replace(Ex_File, "A112", "")                     '消除檔名中"A112"
  30.         Ex_Date = Replace(Ex_Date, "ALL_1.csv", "")                '消除檔名中"ALL_1.csv"
  31.         Ex_Date = DateSerial(Mid(Ex_Date, 1, 4), Mid(Ex_Date, 5, 2), Mid(Ex_Date, 7, 2)) '帶入日期
  32.         With ActiveSheet                                            '作用中的工作表
  33.             Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 A11220070102ALL_1.csv.....
  34.             '************************************************
  35.             .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Ex_Date  '日期輸入
  36.             If Ex_Wb.Sheets(1).Range("B3") <> "" Then
  37.                 Sheet(i).Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find(Name, lookat:=xlWhole).Offset(, 7)
  38.                 Sheet(i).Cells(.Rows.Count, "e").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find(Name, lookat:=xlWhole).Offset(, 4)
  39.                 Sheet(i).Cells(.Rows.Count, "f").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find(Name, lookat:=xlWhole).Offset(, 5)
  40.                Sheet(i).Cells(.Rows.Count, "g").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find(Name, lookat:=xlWhole).Offset(, 6)
  41.                 Sheet(i).Cells(.Rows.Count, "i").End(xlUp).Offset(1) = Ex_Wb.Sheets(1).Range("b:b").Find(Name, lookat:=xlWhole).Offset(, 1)
  42.                     
  43.             Else
  44.                 .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = "---"   '**沒有資料
  45.                 .Cells(.Rows.Count, "e").End(xlUp).Offset(1) = "---"   '**沒有資料
  46.                 .Cells(.Rows.Count, "f").End(xlUp).Offset(1) = "---"   '**沒有資料
  47.                 .Cells(.Rows.Count, "g").End(xlUp).Offset(1) = "---"   '**沒有資料
  48.                 .Cells(.Rows.Count, "i").End(xlUp).Offset(1) = "---"   '**沒有資料
  49.                 '**** 修改作用中的工作表.Range("B1") 為查詢指數的類別  *********
  50.             End If
  51.             '************************************************
  52.             Ex_Wb.Close False                                       '關閉 A11220070102ALL_1.csv.....
  53.         End With
  54.         Ex_File = Dir                                               '下一個"A112*ALL_1.csv"
  55.     Loop
  56.     Application.ScreenUpdating = True
  57.     MsgBox "OK"
  58. End Sub
複製代碼
用很笨拙的方式去寫，卻跑不出結果來，出現錯誤…，可以請板大撥空幫我看看嗎？

TOP

        靜思自在 : 小事不做、大事難成。
123
返回列表 上一主題