123
返回列表 上一主題 發帖

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

gkld

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

論壇贊助勳章
21# 跳轉到 »
發表於 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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
22#
發表於 2013-3-11 08:22 | 只看該作者
本帖最後由 GBKEE 於 2013-3-11 08:25 編輯

回復 21# gkld
說明18#程式碼編寫的邏輯
  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.     Dim Ar() As String, Wb As Workbook
  6.     'Set Wb = Workbooks.Open("D:\股票資料庫.xls")    '開啟股票資料庫的活頁簿
  7.     Ex_Path = "C:\Documents and Settings\gkld\桌面\my kp\資料庫\上市\"   
  8.     Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  9.     If Ex_File = "" Then
  10.         MsgBox "沒有 A112*ALL_1.csv"
  11.         Exit Sub
  12.     End If
  13.     Application.ScreenUpdating = False
  14.     Ar = Array("台泥", "亞泥", "嘉泥", "幸福", "信大", "東泥")
  15.     Ex_File = Dir(Ex_Path & "A112*ALL_1.csv")
  16.     Do While Ex_File <> ""                    ' 尋找 *.csv  的迴圈
  17.          '.............簡略
  18.         For i = 1 To 7                        '工作表的迴圈
  19.             With Sheets(Ar(i - 1))                                      '指定定陣列中的工作表名稱
  20.                 '.............簡略
  21.                 If Not .Columns(1).Find(CDate(Ex_Date), LookIn:=xlFormulas) Is Nothing Then Exit For
  22.                 'If Not .Columns(1).Find 迴圈比對在工作表中比對日期的 If 條件式

  24.                  'Exit For:離開For i = 1 To 7 這回圈:不再重複舊有的資料
  25.                 Set Ex_Wb = Workbooks.Open(Ex_Path & Ex_File)           '開啟 不存日期 的.csv.....
  26.                 '.............簡略
  27.             End With
  28.             Ex_Wb.Close False                                    '關閉 A11220070102ALL_1.csv.....
  29.         Next
  30.         '**************************************
  31.         Ex_File = Dir                                            '下一個"A112*ALL_1.csv"
  32.         'PS 18# 的程式碼有錯誤:  18# 43行程式碼  Ex_File = Dir  須移到  Loop 的前一行 繼續找下一個"A112*ALL_1.csv"
  33.     Loop
  34.         '**************************************
  35.     Application.ScreenUpdating = True
  36.     MsgBox "OK"
  37. End Sub
複製代碼

TOP

gkld

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

論壇贊助勳章
23#
發表於 2013-3-11 21:34 | 只看該作者
回復 22# GBKEE
ok~:D
我已修正完成~
感謝板大細心指導!!

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
123
返回列表 上一主題