但一個Excel的xls檔案卻有很多個sheets
要一個一個存為csv檔實在太浪費時間
所以小弟參考各方資料,寫了這個小功能~
※ 有1~1023列,但每一列不一定有填入產品
|
Note: 要使用該段程式碼前,要先引用"Microsoft Excel 14.0 Object Libarary"!!
Part 1: Convert部份
'Add Microsoft Excel 14.0 Object Libarary to references
Sub XlsToCsv_Click()
Set xls = CreateObject("Excel.Application")
xls.Visible = True 'comment this out if you don't want excel to show
tmp = Dir(App.Path & "\*.xls")
Do While tmp <> ""
xls.DisplayAlerts = False
xls.Workbooks.Open App.Path & "\" & tmp
'※將空白的產品欄位篩選掉(第2欄)
For i = 1 To xls.Worksheets.Count
With xls
'Step1: 先判斷此sheet是否有篩選。Yes→此範圍取消篩選;No→跳過此判斷
.Sheets(i).Activate
If .Sheets(i).FilterMode = True Then
tmpRow = .Sheets(i).Range("A65536").End(xlUp).Row
tmpCol = .Sheets(i).Range("IV1").End(xlToLeft).Column
.Sheets(i).Range(.Cells(1, "A"), .Cells(tmpRow, tmpCol)).AutoFilter
End If
'Step2: 針對「產品」欄位進行篩選(濾掉空白的部份)
cntRow = .Sheets(i).Range("A65536").End(xlUp).Row
cntCol = .Sheets(i).Range("IV1").End(xlToLeft).Column
.Sheets(i).Range(.Cells(1, "A"), .Cells(cntRow, cntCol)).AutoFilter Field:=2, Criteria1:="<>", Operator:=xlFilterValues '把空格篩選掉(沒有填產品的空格)
'Step3: 把篩選出來的部份複製出來,然後再刪除原來的部份
cntRow2 = .Sheets(i).Range("A65536").End(xlUp).Row
.Sheets(i).Range(.Cells(1, "A"), .Cells(cntRow2, cntCol)).Copy Destination:=xls.Sheets(i).Range("A" & cntRow + 1)
.Sheets(i).Range(.Cells(1, "A"), .Cells(cntRow, cntCol)).AutoFilter
.Sheets(i).Rows("1:" & cntRow).Delete Shift:=xlUp
End With
Next i
'※將此檔案的工作表全部各別存為.csv檔 (Worksheets.Count: 總sheet數量)
For i = 1 To xls.Worksheets.Count
xls.Sheets(i).SaveAs FileName:=Replace(App.Path & "\" & xls.Sheets(i).Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
Next i
xls.Workbooks.Close
tmp = Dir
xls.DisplayAlerts = True
Loop
xls.Quit
MsgBox "轉換完成!", vbInformation, ""
End Sub
Part2: 清除目錄下所有.csv檔
Sub Clear_Click()
Response = MsgBox("確定要清除資料夾內的.csv檔案嗎?", vbYesNo, "Clear .csv")
Select Case Response
Case vbYes
GoTo Clear
Case vbNo
Exit Sub
End Select
Clear:
If Dir(App.Path & "\*.csv", vbDirectory) = "" Then
MsgBox ".csv檔不存在!", vbInformation, "錯誤訊息"
Exit Sub
Else
Kill App.Path & "\*.csv" '刪除資料夾下的.csv檔
End If
MsgBox ".csv檔案已清除!", vbInformation, ""
End Sub
按下Convert後,即可輸出每個sheet對應的csv檔 (如下圖) |
打開Table3,內容確實僅有篩選過的資料,大功告成~~ |
範例檔案:XlsToCsv_20180618
沒有留言:
張貼留言