123
返回列表 上一主題 發帖

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

gkld

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

論壇贊助勳章
14# 跳轉到 »
發表於 2012-12-29 23:24 | 只看該作者
回復 13# gkld
上傳做好的個股資料圖片，供像我一樣的新手參考
另外提供所談到的資料圖程式 1.rar (17.65 KB)
當然小弟沒有那麼厲害，想當然也是網路上熱心的先進們提供，
雖然日期部分得手動keyin，不過我個人已覺得很滿足了
只要再將板大的指導加進去所得，就可以做出每檔個股歷史資料啦!!

TOP

gkld

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

論壇贊助勳章
13#
發表於 2012-12-29 22:49 | 只看該作者
回復 12# gkld
不好意思…板大…我找到原因了
是我將程式碼日了些東西-____-#
現在改回來，測試沒問題了~
哈哈哈…開心~
感恩丫!!
繼續研究研究 :)

TOP

gkld

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

論壇贊助勳章
12#
發表於 2012-12-29 20:44 | 只看該作者
熱心的板大：

怎麼會出現『編譯錯誤，有next卻沒有for』的對話方塊？

我一條一條看程式碼，明明就有for嗎？不就是for i=1 to 7，第13行那兒嗎？

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11#
發表於 2012-12-29 08:34 | 只看該作者
回復 10# 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, Ex_Row As Integer, i As Integer ', Ar() As String, Ex_Name As String
  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.     'Ar = Array("台泥", "亞泥", "嘉泥", "幸福", "信大", "東泥")
  13.     For i = 1 To 7
  14.        '** Name 是VBA所用的關鍵字串,避免使用為變數名稱.
  15.        ' If i = 1 Then Ex_Name = "台泥"
  16.        ' If i = 2 Then Ex_Name = "亞泥"
  17.        ' If i = 3 Then Ex_Name = "嘉泥"
  18.        ' If i = 4 Then Ex_Name = "環泥"
  19.        ' If i = 5 Then Ex_Name = "幸福"
  20.        ' If i = 6 Then Ex_Name = "信大"
  21.        ' If i = 7 Then Ex_Name = "東泥"
  22.       
  23.         With Sheets(i)                                                '依工作表索引值指定工作表
  24.         '****工作表名稱 在活頁簿視窗排序如是依IF i=1如此順序***
  25.         '***那就不需這些IF i=1 ...........
  26.       
  27.         'With Sheets(Ex_Name)                                          '依Ex_Name 指定工作表
  28.         '****如在活頁簿視窗工作表名稱排序不是如此順序***
  29.         '***那就需要這些IF i=1 ...........
  30.       
  31.         'With Sheets(Ar(i - 1))                                      '指定定陣列中的工作表名稱
  32.             .Range("a1:ag65536").Clear '消除每一行資料
  33.             Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  34.             Do While Ex_File <> ""
  35.                 Ex_Date = Replace(Ex_File, "A112", "")                     '消除檔名中"A112"
  36.                 Ex_Date = Replace(Ex_Date, "ALL_1.csv", "")                '消除檔名中"ALL_1.csv"
  37.                 Ex_Date = DateSerial(Mid(Ex_Date, 1, 4), Mid(Ex_Date, 5, 2), Mid(Ex_Date, 7, 2)) '帶入日期
  38.                
  39.                 Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 A11220070102ALL_1.csv.....
  40.                 '************************************************
  41.                 Ex_Row = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row '取得資料輸入的列號
  42.                 Set Rng = Ex_Wb.Sheets(1).Range("b:b").Find(.Name, lookat:=xlWhole)
  43.                  '.Cells(Ex_Row, "A") = Ex_Date  '日期輸入         '** 記錄所有日期***
  44.                 If Not Rng Is Nothing Then
  45.                     .Cells(Ex_Row, "A") = Ex_Date '日期輸入  如移到這裡 '** 只記錄有資料的日期
  46.                     .Cells(Ex_Row, "B") = Rng.Offset(, 7)
  47.                     .Cells(Ex_Row, "e") = Rng.Offset(, 4)
  48.                     .Cells(Ex_Row, "f") = Rng.Offset(, 5)
  49.                     .Cells(Ex_Row, "g") = Rng.Offset(, 6)
  50.                     .Cells(Ex_Row, "i") = Rng.Offset(, 1)
  51.                 End If
  52.                 '************************************************
  53.                 Ex_Wb.Close False                                       '關閉 A11220070102ALL_1.csv.....
  54.                 Ex_File = Dir                                               '下一個"A112*ALL_1.csv"
  55.             Loop
  56.         End With
  57.     Next
  58.     Application.ScreenUpdating = True
  59.     MsgBox "OK"
  60. End Sub
複製代碼

TOP

gkld

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

論壇贊助勳章
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

gkld

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

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

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

感謝板大鼎力相助

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

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 
最後登錄
2025-12-15 

論壇贊助勳章
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兔年全勤獎章
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 
最後登錄
2025-12-15 

論壇贊助勳章
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

        靜思自在 : 甘願做、歡喜受。
123
返回列表 上一主題