- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
3#
發表於 2017-3-4 14:31
| 只看該作者
回復 1# oak0723-1
試試看- Option Explicit
- Dim Wb As Workbook
- Sub Ex()
- Dim xFile As String, Sh As Worksheet, i As Integer, Rng As Range
- Set Wb = Workbooks("03.XLS") '指定的XLS擋
- xFile = ThisFile
- If InStr(xFile, "CSV") = False Then MsgBox xFile: Exit Sub
- Set Sh = Wb.Sheets("SHEET1") '指定的XLS擋的工作頁
- With Workbooks.Open(xFile)
- For i = 1 To 2
- Set Rng = .Sheets(1).Range(Sh.Cells(1 + 1, "E") & ":" & Sh.Cells(1 + i, "F")) '指定的位置
- Set Rng = .Sheets(1).Range(Rng, Rng.End(xlDown)) ''指定的位置往下至資料的終點
- With Sh.Cells(Rows.Count, "a").End(xlUp).Offset(1) 'A欄最底列往上到有資料的儲存閣的下一列
- .Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
- End With
- Next
- .Close
- End With
- End Sub
- Function ThisFile() As String
- With Wb '**指定的XLS擋
- ThisFile = Mid(.Path, 1, InStrRev(.Path, "\")) '**指定的XLS擋的上層資料夾
- With .Sheets("Sheet1")
- ThisFile = ThisFile & .Range("b2") & "\" & .Range("c2") & ".CSV" '上層資料夾+子資料\的CSV檔案完整路徑
- '**** 檢查CSV的檔案是否存在
- If Dir(ThisFile) = "" Or Application.CountA(.Range("E2:F3")) <> 4 Then ThisFile = "請檢查" & vbLf & Join(Application.Transpose(Application.Transpose([B1:F1])), ",")
- End With
- End With
- End Function
|
|
發表於 2017-3-2 13:49
| 
