Excel: 현재 Excel 시트를 그대로 두지 않고 워크시트를 CSV 파일로 내보낼 수 있는 매크로

Excel: 현재 Excel 시트를 그대로 두지 않고 워크시트를 CSV 파일로 내보낼 수 있는 매크로

워크시트를 CSV 파일로 저장하기 위한 매크로를 작성하려면 많은 질문이 있습니다.모든 답변은 SuperUser의 SaveAs를 사용합니다.기본적으로 다음과 같은 VBA 기능을 만들라고 합니다.

Sub SaveAsCSV()
    ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub

좋은 답변이지만 다른 이름으로 저장 대신 내보내기를 원합니다.SaveAs가 실행되면 다음 두 가지 문제가 발생합니다.

• 현재 작업 중인 파일이 CSV 파일이 됩니다.원래 .xlsm 파일로 작업을 계속하고 싶지만 현재 워크시트의 내용을 같은 이름의 CSV 파일로 내보냅니다.
• CSV 파일을 재작성할지를 확인하는 대화상자가 나타납니다.

현재 워크시트를 파일로 내보내고 원래 파일로 작업을 계속할 수 있습니까?

@NathanClement가 조금 더 빨랐습니다.단, 여기 완전한 코드가 있습니다(조금 더 상세하게)

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

@Ralph는 거의 제가 원하던 것이지만, 여기 가장 좋은 답이 있습니다. 왜냐하면 당신의 코드에 있는 몇 가지 문제를 해결해주기 때문입니다.

1. "Sheet1"이라는 이름의 하드코드 시트 대신 현재 시트를 내보냅니다.
2. 현재 시트로 명명된 파일로 내보냅니다.
3. 로케일 구분 문자를 존중합니다.
4. 내보낸 CSV를 편집하는 대신 xlsx 파일을 계속 편집합니다.

이러한 문제를 해결하고 모든 요건을 충족하기 위해 여기서부터 코드를 수정했습니다.좀 더 읽기 쉽게 닦았어요.

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

상기 코드의 특징에 주의해 주세요.

1. 현재 파일 이름이 .xlsm과 같이 4글자인 경우에만 작동합니다..xls에서는 오래된 파일을 사용할 수 없습니다.파일 확장자가 3글자인 경우,- 5로.- 4위의 코드에서 My FileName을 설정할 때 사용합니다.
2. 부수적인 효과로 클립보드가 현재 시트 내용으로 대체됩니다.

편집: 입력Local:=True로케일 CSV 딜리미터를 사용하여 저장합니다.

@neves 투고 코멘트에 따라 xlPasteFormats와 날짜로 전달되는 값 부분을 추가하여 약간 개선하였습니다.대부분은 은행 명세서에 CSV로 저장하기 때문에 날짜가 필요했습니다.

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

이 답변에서는 다른 사용자에게 도움이 될 수 있도록 .xlsx 파일과 .xls 파일을 모두 같은 루틴으로 처리하도록 약간 개선되었습니다.

또한 워크북 대신 활성 시트 이름으로 저장하도록 선택할 행을 추가합니다. 이 이름은 저에게 가장 실용적인 방법입니다.

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

출력(세퍼레이터 또는 소수점 기호)을 좀 더 커스터마이즈해야 하는 경우 또는 큰 데이터 세트(65k 행 이상)를 가지고 있는 경우, 다음과 같이 적습니다.

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

1. 워크시트를 사용할 수 있습니다.인수 없이 복사하여 워크시트를 새 워크북에 복사합니다.워크시트이동하면 워크시트가 새 워크북에 복사되고 원래 워크북에서 제거됩니다("내보내기"라고 할 수 있습니다).
2. 새로 생성된 워크북에 대한 참조를 가져와 CSV로 저장합니다.
3. 표시 설정경고를 false로 설정하여 경고 메시지를 표시하지 않도록 합니다(완료하면 다시 켜는 것을 잊지 마십시오).
4. 디스플레이가 필요합니다.워크북을 저장할 때와 닫을 때 알림이 꺼졌습니다.

    wsToExport.Move

    With Workbooks
        Set wbCsv = .Item(.Count)
    End With

    Application.DisplayAlerts = False
    wbCsv.SaveAs xlCSV
    wbCsv.Close False
    Application.DisplayAlerts = True

이 사이트에는, 코멘트한 대로, 워크시트의 내용을 CSV에 기입하고 있는 곳이 몇개인가 있습니다.이거랑 이거랑 딱 두 개만 지적하면 돼요.

아래는 내 버전입니다.

• 세포 내에서 "를 명시적으로 감시합니다.
• , 「」를 사용합니다.UsedRange 모든 에 - ㄴㄴㄴㄴㄴㄴㄴㄴㄴㄴㄴㄴㄴㄴㄴㄴ지 모르다.
• 워크시트 셀을 통해 루프하는 것보다 더 빠르기 때문에 루프에 어레이를 사용합니다.
• FSO 루틴을 사용하지 않았지만 이는 옵션입니다.

암호는...

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

언급URL : https://stackoverflow.com/questions/37037934/excel-macro-to-export-worksheet-as-csv-file-without-leaving-my-current-excel-sh