- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 10# gkld - 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
複製代碼 |
|