Hướng dẫn excel macro export to csv - xuất macro excel sang csv

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:

1. 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. nó xuất sang một tệp được đặt tên là bảng hiện tại
3. Nó tôn trọng char phân tách địa phương.
4. 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:

1. 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.
2. 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

Đã 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

1. 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.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).
2. Đã trả lời ngày 4 tháng 5 năm 2016 lúc 22:01
3. 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.
4. 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

Làm thế nào chuyển đổi Excel sang CSV VBA?

Bạn có thể xuất một macro excel không?

Macro có thể hoạt động với tệp CSV không?

Cách nhanh nhất để chuyển đổi Excel thành CSV là gì?