Có rất nhiều câu hỏi ở đây để tạo một macro để lưu một bảng tính dưới dạng tệp CSV. Tất cả các câu trả lời sử dụng Saveas, như câu này từ Superuser. Về cơ bản, họ nói để tạo ra một chức năng VBA như thế này:
Sub SaveAsCSV[]
ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub
Đây là một câu trả lời tuyệt vời, nhưng tôi muốn xuất khẩu thay vì tiết kiệm như. Khi Saveas được thực hiện, nó khiến tôi có hai phiền toái:export instead of Save As. When the SaveAs is executed it causes me two annoyances:
- Tệp làm việc hiện tại của tôi trở thành một tệp CSV. Tôi muốn tiếp tục làm việc trong tệp .xlsm gốc của mình, nhưng để xuất nội dung của bảng tính hiện tại sang tệp CSV có cùng tên.
- Một hộp thoại xuất hiện yêu cầu tôi xác nhận rằng tôi muốn viết lại tệp CSV.
Có thể chỉ xuất bảng tính hiện tại dưới dạng tệp, nhưng để tiếp tục làm việc trong tệp gốc của tôi?
Khi được hỏi ngày 4 tháng 5 năm 2016 lúc 21:01May 4, 2016 at 21:01
Nevesnevesneves
29.2K25 Huy hiệu vàng142 Huy hiệu bạc173 Huy hiệu đồng25 gold badges142 silver badges173 bronze badges
5
@Nathancess là nhanh hơn một chút. Tuy nhiên, đây là mã hoàn chỉnh [công phu hơn một chút]:
Option Explicit
Public Sub ExportWorksheetAndSaveAsCSV[]
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets["Sheet1"] 'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets[wbkExport.Worksheets.Count]
Application.DisplayAlerts = False 'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub
Đã trả lời ngày 4 tháng 5 năm 2016 lúc 21:31May 4, 2016 at 21:31
RalphralphRalph
9.2244 Huy hiệu vàng32 Huy hiệu bạc42 Huy hiệu đồng4 gold badges32 silver badges42 bronze badges
1
Hầu như những gì tôi muốn @ralph, nhưng đây là câu trả lời tốt nhất, bởi vì nó giải quyết một số phiền toái trong mã của bạn:best answer, because it solves some annoyances in your code:
- Nó xuất bảng hiện tại, thay vì chỉ là tấm được mã hóa cứng có tên là "Sheet1";
- nó xuất sang một tệp được đặt tên là bảng hiện tại
- Nó tôn trọng char phân tách địa phương.
- Bạn tiếp tục chỉnh sửa tệp XLSX của mình, thay vì chỉnh sửa CSV đã xuất.
Để giải quyết những vấn đề này và đáp ứng tất cả các yêu cầu của tôi, tôi đã điều chỉnh mã từ đây. Tôi đã làm sạch nó một chút để làm cho nó dễ đọc hơn.
Option Explicit
Sub ExportAsCSV[]
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add[1]
With TempWB.Sheets[1].Range["A1"]
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left[CurrentWB.Name, Len[CurrentWB.Name] - 5] & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Lưu ý một số đặc điểm của mã ở trên:
- Nó hoạt động chỉ nếu tên tệp hiện tại có 4 chữ cái, như .xlsm. Sẽ không hoạt động trong các tệp cũ .xls Excel. Đối với các phần mở rộng tệp của 3 ký tự, bạn phải thay đổi
- 5
thành- 4
khi đặt myFilename trong mã trên. - Là một hiệu ứng tài sản thế chấp, bảng tạm của bạn sẽ được thay thế bằng nội dung tờ hiện tại.
Chỉnh sửa: Đặt
Option Explicit
Public Sub ExportWorksheetAndSaveAsCSV[]
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets["Sheet1"] 'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets[wbkExport.Worksheets.Count]
Application.DisplayAlerts = False 'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub
0 để lưu với dấu phân cách CSV địa phương của tôi.
Đã trả lời ngày 4 tháng 5 năm 2016 lúc 22:01May 4, 2016 at 22:01
Nevesnevesneves
29.2K25 Huy hiệu vàng142 Huy hiệu bạc173 Huy hiệu đồng25 gold badges142 silver badges173 bronze badges
7
@Nathancess là nhanh hơn một chút. Tuy nhiên, đây là mã hoàn chỉnh [công phu hơn một chút]:
Sub ExportAsCSV[]
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add[1]
With TempWB.Sheets[1].Range["A1"]
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
'Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left[CurrentWB.Name, Len[CurrentWB.Name] - 5] & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Đã trả lời ngày 4 tháng 5 năm 2016 lúc 21:31
Ralphralph2 gold badges26 silver badges42 bronze badges
9.2244 Huy hiệu vàng32 Huy hiệu bạc42 Huy hiệu đồngDec 20, 2017 at 8:13
Hầu như những gì tôi muốn @ralph, nhưng đây là câu trả lời tốt nhất, bởi vì nó giải quyết một số phiền toái trong mã của bạn:Craig Lambie
Nó xuất bảng hiện tại, thay vì chỉ là tấm được mã hóa cứng có tên là "Sheet1";2 gold badges13 silver badges15 bronze badges
3
nó xuất sang một tệp được đặt tên là bảng hiện tại
Nó tôn trọng char phân tách địa phương.
Sub ExportAsCSV[]
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add[1]
With TempWB.Sheets[1].Range["A1"]
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
MyFileName = CurrentWB.Path & "\" & Left[CurrentWB.Name, InStrRev[CurrentWB.Name, "."] - 1] & ".csv"
'Optionally, comment previous line and uncomment next one to save as the current sheet name
'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Bạn tiếp tục chỉnh sửa tệp XLSX của mình, thay vì chỉnh sửa CSV đã xuất.May 5, 2020 at 21:20
Để giải quyết những vấn đề này và đáp ứng tất cả các yêu cầu của tôi, tôi đã điều chỉnh mã từ đây. Tôi đã làm sạch nó một chút để làm cho nó dễ đọc hơn.
Option Explicit
Sub rng2csv[rng As Range, fileName As String, Optional sep As String = ";", Optional decimalSign As String]
'export range data to a CSV file, allowing to chose the separator and decimal symbol
'can export using rng number formatting!
'by Patrick Honorez --- www.idevlop.com
Dim f As Integer, i As Long, c As Long, r
Dim ar, rowAr, sOut As String
Dim replaceDecimal As Boolean, oldDec As String
Dim a As Application: Set a = Application
ar = rng
f = FreeFile[]
Open fileName For Output As #f
oldDec = Format[0, "."] 'current client's decimal symbol
replaceDecimal = [decimalSign ""] And [decimalSign oldDec]
For Each r In rng.Rows
rowAr = a.Transpose[a.Transpose[r.Value]]
If replaceDecimal Then
For c = 1 To UBound[rowAr]
'use isnumber[] to avoid cells with numbers formatted as strings
If a.IsNumber[rowAr[c]] Then
'uncomment the next 3 lines to export numbers using source number formatting
' If r.cells[1, c].NumberFormat "General" Then
' rowAr[c] = Format$[rowAr[c], r.cells[1, c].NumberFormat]
' End If
rowAr[c] = Replace[rowAr[c], oldDec, decimalSign, 1, 1]
End If
Next c
End If
sOut = Join[rowAr, sep]
Print #f, sOut
Next r
Close #f
End Sub
Sub export[]
Debug.Print Now, "Start export"
rng2csv shOutput.Range["a1"].CurrentRegion, RemoveExt[ThisWorkbook.FullName] & ".csv", ";", "."
Debug.Print Now, "Export done"
End Sub
Lưu ý một số đặc điểm của mã ở trên:Nov 5, 2019 at 10:25
Nó hoạt động chỉ nếu tên tệp hiện tại có 4 chữ cái, như .xlsm. Sẽ không hoạt động trong các tệp cũ .xls Excel. Đối với các phần mở rộng tệp của 3 ký tự, bạn phải thay đổi - 5
thành - 4
khi đặt myFilename trong mã trên.iDevlop
Là một hiệu ứng tài sản thế chấp, bảng tạm của bạn sẽ được thay thế bằng nội dung tờ hiện tại.11 gold badges88 silver badges145 bronze badges
2
- Chỉnh sửa: Đặt
0 để lưu với dấu phân cách CSV địa phương của tôi.Worksheet.Copy with no arguments to copy the worksheet to a new workbook. Worksheet.Move will copy the worksheet to a new workbook and remove it from the original workbook [you might say "export" it].Option Explicit Public Sub ExportWorksheetAndSaveAsCSV[] Dim wbkExport As Workbook Dim shtToExport As Worksheet Set shtToExport = ThisWorkbook.Worksheets["Sheet1"] 'Sheet to export as CSV Set wbkExport = Application.Workbooks.Add shtToExport.Copy Before:=wbkExport.Worksheets[wbkExport.Worksheets.Count] Application.DisplayAlerts = False 'Possibly overwrite without asking wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV Application.DisplayAlerts = True wbkExport.Close SaveChanges:=False End Sub
- Đã trả lời ngày 4 tháng 5 năm 2016 lúc 22:01
- Theo bình luận của tôi trên bài đăng @Neves, tôi đã cải thiện một chút điều này bằng cách thêm XLPasteFormats cũng như phần giá trị để ngày đi qua như ngày - tôi chủ yếu lưu dưới dạng CSV cho các báo cáo ngân hàng, vì vậy cần thiết.
- Davesexcel
wsToExport.Move
With Workbooks
Set wbCsv = .Item[.Count]
End With
Application.DisplayAlerts = False
wbCsv.SaveAs xlCSV
wbCsv.Close False
Application.DisplayAlerts = True
6.4992 Huy hiệu vàng26 Huy hiệu bạc42 Huy hiệu ĐồngMar 31, 2021 at 15:09
Đã trả lời ngày 20 tháng 12 năm 2017 lúc 8:13Nicholas Hunter
Craig Lambiecraig Lambie1 gold badge11 silver badges14 bronze badges
2.8002 Huy hiệu vàng13 Huy hiệu bạc15 Huy hiệu Đồng
Dưới đây là một cải tiến nhỏ về câu trả lời này ở trên chăm sóc cả hai tệp .xlsx và .xls trong cùng một thói quen, trong trường hợp nó giúp ai đó!
- Tôi cũng thêm một dòng để chọn lưu với tên trang tính hoạt động thay vì sổ làm việc, điều này thực tế nhất đối với tôi:
- Đã trả lời ngày 5 tháng 5 năm 2020 lúc 21:20
- Đối với những tình huống mà bạn cần tùy chỉnh thêm một chút về đầu ra [dấu phân cách hoặc ký hiệu thập phân] hoặc người có bộ dữ liệu lớn [hơn 65k hàng], tôi đã viết như sau:
- Đã trả lời ngày 5 tháng 11 năm 2019 lúc 10:25
IDEVLOPIDEVLOP
Sub makeCSV[theSheet As Worksheet]
Dim iFile As Long, myPath As String
Dim myArr[] As Variant, outStr As String
Dim iLoop As Long, jLoop As Long
myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile
myArr = theSheet.UsedRange
For iLoop = LBound[myArr, 1] To UBound[myArr, 1]
outStr = ""
For jLoop = LBound[myArr, 2] To UBound[myArr, 2] - 1
If InStr[1, myArr[iLoop, jLoop], ","] Then
outStr = outStr & """" & myArr[iLoop, jLoop] & """" & ","
Else
outStr = outStr & myArr[iLoop, jLoop] & ","
End If
Next jLoop
If InStr[1, myArr[iLoop, jLoop], ","] Then
outStr = outStr & """" & myArr[iLoop, UBound[myArr, 2]] & """"
Else
outStr = outStr & myArr[iLoop, UBound[myArr, 2]]
End If
Print #iFile, outStr
Next iLoop
Close iFile
Erase myArr
End Sub
24.4K11 Huy hiệu vàng88 Huy hiệu bạc145 Huy hiệu đồngMay 4, 2016 at 22:37
Bạn có thể sử dụng bảng tính.Copy không có đối số để sao chép bảng tính vào sổ làm việc mới. Worksheet.move sẽ sao chép bảng tính vào sổ làm việc mới và xóa nó khỏi sổ làm việc gốc [bạn có thể nói "xuất" nó].OldUgly
Lấy một tham chiếu đến sổ làm việc mới được tạo và lưu dưới dạng CSV.3 gold badges13 silver badges21 bronze badges