gkld

回復 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 這個回圈了

該如何解決？

GBKEE

回復 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 條件式
    
23. 
    
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

複製代碼

gkld

回復 22# GBKEE
ok~:D
我已修正完成~
感謝板大細心指導!!