12
返回列表 上一主題 發帖

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

gkld

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

論壇贊助勳章
11# 跳轉到 »
發表於 2013-3-8 19:24 | 顯示全部帖子
回復 11# GBKEE
請問板大…
您的這個方式，我用了一陣子
後來發現，如果我有幾筆新最近日期的資料，如A11220130307ALL_1.csv…要放入股票資料庫裡，
執行您教的這個vba的話，它會整個從資料庫裡的每筆舊日期資料重新跑過，挑出來重新排列
這樣很浪費時間
有辦法執行vba的時候，不用再去抓舊日期的資料，只對新筆資料做新增出來作為每日歷史股價嗎？感恩

TOP

gkld

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

論壇贊助勳章
12#
發表於 2013-3-9 20:26 | 顯示全部帖子
回復 16# GBKEE
唉呀…板大
我想是我的表達方式讓你誤會成，我只要截取近1週的資料而已
其實是那個股票的資料庫，每天都會有新的資料進來，然後我執行
  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.           [s][color=Red]  .Range("a1:ag65536").Clear '消除每一行資料[/color][/s]
  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
複製代碼
每都都會連同舊的資料一起重抓重跑，時間秏費不少
我想要的結果是之前執行後的舊資料會留著，每當我有一筆新資料進來時，就只要跑新的資料新增就好
因為我vb不好，沒法子像板大一樣，可以寫出比對資料庫裡的data，只把新進來的data抓出來，
後來剛吃晚餐時，突然想到另一個解決方式
我將新的data放進另一個新的資料夾，然後不要消除每一行的資料，即執行以下程式碼
Option Explicit
Sub Ex()
    Dim Ex_Path As String, Ex_File As String, Ex_Date As String, Ex_Wb As Workbook
    Dim Rng As Range, Ex_Row As Integer, i As Integer ', Ar() As String, Ex_Name As String
    Ex_Path = "C:\Documents and Settings\gkld\桌面\my kp\資料庫\新資料夾\"
    Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
    If Ex_File = "" Then
        MsgBox "沒有 A112*ALL_1.csv"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    'Ar = Array("台泥", "亞泥", "嘉泥", "幸福", "信大", "東泥")
    For i = 1 To 7
       '** Name 是VBA所用的關鍵字串,避免使用為變數名稱.
       ' If i = 1 Then Ex_Name = "台泥"
       ' If i = 2 Then Ex_Name = "亞泥"
       ' If i = 3 Then Ex_Name = "嘉泥"
       ' If i = 4 Then Ex_Name = "環泥"
       ' If i = 5 Then Ex_Name = "幸福"
       ' If i = 6 Then Ex_Name = "信大"
       ' If i = 7 Then Ex_Name = "東泥"
      
        With Sheets(i)                                                '依工作表索引值指定工作表
        '****工作表名稱 在活頁簿視窗排序如是依IF i=1如此順序***
        '***那就不需這些IF i=1 ...........
      
        'With Sheets(Ex_Name)                                          '依Ex_Name 指定工作表
        '****如在活頁簿視窗工作表名稱排序不是如此順序***
        '***那就需要這些IF i=1 ...........
      
        'With Sheets(Ar(i - 1))                                      '指定定陣列中的工作表名稱
            .Range("a1:ag65536").Clear '消除每一行資料
            Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
            Do While Ex_File <> ""
                Ex_Date = Replace(Ex_File, "A112", "")                     '消除檔名中"A112"
                Ex_Date = Replace(Ex_Date, "ALL_1.csv", "")                '消除檔名中"ALL_1.csv"
                Ex_Date = DateSerial(Mid(Ex_Date, 1, 4), Mid(Ex_Date, 5, 2), Mid(Ex_Date, 7, 2)) '帶入日期
               
                Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 A11220070102ALL_1.csv.....
                '************************************************
                Ex_Row = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row '取得資料輸入的列號
                Set Rng = Ex_Wb.Sheets(1).Range("b:b").Find(.Name, lookat:=xlWhole)
                 '.Cells(Ex_Row, "A") = Ex_Date  '日期輸入         '** 記錄所有日期***
                If Not Rng Is Nothing Then
                    .Cells(Ex_Row, "A") = Ex_Date '日期輸入  如移到這裡 '** 只記錄有資料的日期
                    .Cells(Ex_Row, "B") = Rng.Offset(, 7)
                    .Cells(Ex_Row, "e") = Rng.Offset(, 4)
                    .Cells(Ex_Row, "f") = Rng.Offset(, 5)
                    .Cells(Ex_Row, "g") = Rng.Offset(, 6)
                    .Cells(Ex_Row, "i") = Rng.Offset(, 1)
                End If
                '************************************************
                Ex_Wb.Close False                                       '關閉 A11220070102ALL_1.csv.....
                Ex_File = Dir                                               '下一個"A112*ALL_1.csv"
            Loop
        End With
    Next
    Application.ScreenUpdating = True
    MsgBox "OK"
End Sub
好像也可以解決
唉…只能用笨方法了

TOP

gkld

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

論壇贊助勳章
13#
發表於 2013-3-10 18:42 | 顯示全部帖子
回復 18# GBKEE
呀…
板主說的沒有錯，因這行  .Range("a1:ag65536").Clear   '會消除所有的舊資料，我昨晚有把它刪除
試過這樣是可以，昨晚我po的程式碼，忘了把這行改掉，只要將消除所有的舊資料的程式碼那行拿掉，透過用兩個資料夾的方式還是有成功

我現在來試試板的方法看看~

TOP

gkld

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

論壇贊助勳章
14#
發表於 2013-3-10 20:37 | 顯示全部帖子
回復 18# GBKEE
板大…如果程式碼如下
  1. Sub Ex()
  2.     Dim Ex_Path As String, Ex_File As String, Ex_Date As String, Ex_Wb As Workbook
  3.     Dim Rng As Range, Ex_Row As Integer, i As Integer ', Ar() As String, Ex_Name As String
  4.     Ex_Path = "C:\Documents and Settings\gkld\桌面\my kp\資料庫\old 上市\"
  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.     'Ar = Array("台泥", "亞泥", "嘉泥", "幸福", "信大", "東泥")
  12.     For i = 2 To 8
  13.        '** Name 是VBA所用的關鍵字串,避免使用為變數名稱.
  14.        ' If i = 1 Then Ex_Name = "台泥"
  15.        ' If i = 2 Then Ex_Name = "亞泥"
  16.        ' If i = 3 Then Ex_Name = "嘉泥"
  17.        ' If i = 4 Then Ex_Name = "環泥"
  18.        ' If i = 5 Then Ex_Name = "幸福"
  19.        ' If i = 6 Then Ex_Name = "信大"
  20.        ' If i = 7 Then Ex_Name = "東泥"
  21.       
  22.         With Sheets(i)                                                '依工作表索引值指定工作表
  23.         '****工作表名稱 在活頁簿視窗排序如是依IF i=1如此順序***
  24.         '***那就不需這些IF i=1 ...........
  25.       
  26.         'With Sheets(Ex_Name)                                          '依Ex_Name 指定工作表
  27.         '****如在活頁簿視窗工作表名稱排序不是如此順序***
  28.         '***那就需要這些IF i=1 ...........
  29.       
  30.         'With Sheets(Ar(i - 1))                                      '指定定陣列中的工作表名稱
  31.             .Range("m1:ag65536").Clear '消除每一行資料
  32.             .Range("a1") = "日期"           '製作表頭
  33.             .Range("b1") = "收盤"
  34.             .Range("c1") = "漲跌"
  35.             .Range("d1") = "漲跌率"
  36.             .Range("e1") = "開盤"
  37.             .Range("f1") = "最高"
  38.             .Range("g1") = "最低"
  39.             .Range("h1") = "成交量(單位)"
  40.             .Range("i1") = "成交量"
  41.             Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  42.             Do While Ex_File <> ""
  43.                 Ex_Date = Replace(Ex_File, "A112", "")                     '消除檔名中"A112"
  44.                 Ex_Date = Replace(Ex_Date, "ALL_1.csv", "")                '消除檔名中"ALL_1.csv"
  45.                 Ex_Date = DateSerial(Mid(Ex_Date, 1, 4), Mid(Ex_Date, 5, 2), Mid(Ex_Date, 7, 2)) '帶入日期
  46.          If .Columns(1).Find(CDate(Ex_Date), LookIn:=xlFormulas) Is Nothing Then Ex_File = Dir
  47.          '***  不再重複舊有資料 ****'CD(EX_Date)日期->工作表A欄中找到日期間(有)：離開回圈
  48.          
  49.          
  50.                     Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 A11220070102ALL_1.csv.....
  51.                 '************************************************
  52.                 Ex_Row = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row '取得資料輸入的列號
  53.                 Set Rng = Ex_Wb.Sheets(1).Range("a:a").Find(.Name, lookat:=xlWhole)
  54.                  '.Cells(Ex_Row, "A") = Ex_Date  '日期輸入         '***記錄所有日期***
  55.                 If Not Rng Is Nothing Then
  56.                     .Cells(Ex_Row, "A") = Ex_Date '日期輸入  如移到這裡 '** 只記錄有資料的日期
  57.                     .Cells(Ex_Row, "B") = Rng.Offset(, 8)
  58.                     .Cells(Ex_Row, "e") = Rng.Offset(, 5)
  59.                     .Cells(Ex_Row, "f") = Rng.Offset(, 6)
  60.                     .Cells(Ex_Row, "g") = Rng.Offset(, 7)
  61.                     .Cells(Ex_Row, "i") = Rng.Offset(, 2)
  62.                 End If
  63.                 '************************************************
  64.                 Ex_Wb.Close False                                       '關閉 A11220070102ALL_1.csv.....
  65.       
  66.                 Ex_File = Dir                                               '下一個"A112*ALL_1.csv"
  67.             Loop
  68.         End With
  69.     Next
  70.     Application.ScreenUpdating = True
  71.     MsgBox "OK"
  72. End Sub
複製代碼
那麼

         If .Columns(1).Find(CDate(Ex_Date), LookIn:=xlFormulas) Is Nothing Then Ex_File = Dir
         '***  不再重複舊有資料 ****'CD(EX_Date)日期->工作表A欄中找到日期間(有)：離開回圈

該放在哪兒，才能執行成功？

TOP

gkld

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

論壇贊助勳章
15#
發表於 2013-3-10 21:09 | 顯示全部帖子
回復 20# 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
  5.     Ex_Path = "C:\Documents and Settings\gkld\桌面\my kp\資料庫\old 上市\"
  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.   
  13.     For i = 2 To 8
  14.    
  15.         With Sheets(i)
  16.         
  17.             .Range("a1") = "日期"           '製作表頭
  18.             .Range("b1") = "收盤"
  19.             .Range("c1") = "漲跌"
  20.             .Range("d1") = "漲跌率"
  21.             .Range("e1") = "開盤"
  22.             .Range("f1") = "最高"
  23.             .Range("g1") = "最低"
  24.             .Range("h1") = "成交量(單位)"
  25.             .Range("i1") = "成交量"
  26.             Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  27.             Do While Ex_File <> ""
  28.                 Ex_Date = Replace(Ex_File, "A112", "")                     '消除檔名中"A112"
  29.                 Ex_Date = Replace(Ex_Date, "ALL_1.csv", "")                '消除檔名中"ALL_1.csv"
  30.                 Ex_Date = DateSerial(Mid(Ex_Date, 1, 4), Mid(Ex_Date, 5, 2), Mid(Ex_Date, 7, 2)) '帶入日期
  31.                 If Not .Columns(1).Find(CDate(Ex_Date), LookIn:=xlFormulas) Is Nothing Then Exit For
  32.                 '***  不再重複舊有資料  ****'CDate(Ex_Date)日期 -> 工作表A欄中 找到日期(有):離開回圈
  33.                 'CDate函數   Date任何可使用的日期運算式。
  34.                     Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 A11220070102ALL_1.csv.....
  35.                 '************************************************
  36.                 Ex_Row = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row '取得資料輸入的列號
  37.                 Set Rng = Ex_Wb.Sheets(1).Range("a:a").Find(.Name, LookAt:=xlWhole)
  38.             
  39.                 If Not Rng Is Nothing Then
  40.                     .Cells(Ex_Row, "A") = Ex_Date '日期輸入  如移到這裡 '** 只記錄有資料的日期
  41.                     .Cells(Ex_Row, "B") = Rng.Offset(, 8)
  42.                     .Cells(Ex_Row, "e") = Rng.Offset(, 5)
  43.                     .Cells(Ex_Row, "f") = Rng.Offset(, 6)
  44.                     .Cells(Ex_Row, "g") = Rng.Offset(, 7)
  45.                     .Cells(Ex_Row, "i") = Rng.Offset(, 2)
  46.                 End If
  47.                 '************************************************
  48.                 Ex_Wb.Close False                                       '關閉 A11220070102ALL_1.csv.....
  49.                ' End If                                                            '*****一周內的日期
  50.                 Ex_File = Dir                                               '下一個"A112*ALL_1.csv"
  51.             Loop
  52.         End With
  53.     Next
  54.     Application.ScreenUpdating = True
  55.     MsgBox "OK"
  56. End Sub
複製代碼
放的位置如上，我執行的時候，就直接跳出我的i=2 to 8 這個回圈了

該如何解決？

TOP

gkld

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

論壇贊助勳章
16#
發表於 2013-3-11 21:34 | 顯示全部帖子
回復 22# GBKEE
ok~:D
我已修正完成~
感謝板大細心指導!!

TOP

        靜思自在 : 要比誰更受誰．不要比誰更怕誰。
12
返回列表 上一主題