- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
23#
發表於 2012-6-8 16:31
| 只看該作者
回復 22# luke - Option Explicit
- Sub 拆檔()
- Dim Ar(), MyPath As String, E As Range, Rng As Range, xlFileName As String
- Dim ArFile(), Msg As String
- 'CurDir 傳回一個 Variant (String)，用來代表目前的路徑。
- MyPath = CurDir & "\" '自行修改正確路徑。
- If Dir(MyPath & "*.csv") <> "" Then Kill MyPath & "*.csv" '刪除目前的路徑下的.cgs 檔案
- With Workbooks("TEST21.csv").Sheets(1)
- Ar = .Range("a:a").Value
- .Range("a:a").Replace "[*.*]", "=1/0" '[*.*] 替代為錯誤值
- .Range("a:a").SpecialCells(xlCellTypeFormulas, xlErrors).Name = "xx" '定義名稱: 錯誤值的儲存格
- .Range("a:a").Value = Ar
- For Each E In .[XX]
- Set Rng = E.CurrentRegion
- Set Rng = .Range(E.Cells(2, 1), Rng.Cells(Rng.Rows.Count, Rng.Columns.Count))
- xlFileName = Replace(Replace(E, "[*", ""), "*]", "")
- With Workbooks.Add(1)
- Rng.Copy .Sheets(1).[a1]
- .SaveAs MyPath & xlFileName, xlUnicodeText
- .Close 0
- End With
- Next
- .Parent.Close 0
- End With
- End Sub
|
|
發表於 2012-6-2 16:44
| 
