如何保存csv格式的工作表，同时保持列分隔格式？

我正在从一个源（表）创build多个工作表的VBA代码。 我试图将它们单独保存为CSV格式以将其用于批量input。 但是，要求在CSV文件中保存的工作表必须保持“列分隔格式”。

这是我在哪里：

For i = 0 To nb If Sheets("PjtDef").Range("A2").Offset(k + i, 0).Value <> "" Then Sheets("PjtDef").Range("A2").Offset(k + i, 0).Select Sheets("PjtDef").Range("A1", ActiveCell).EntireRow.Copy Sheets.Add ActiveSheet.Name = h ActiveSheet.Paste Worksheets("PjtDef").Activate Sheets("PjtDef").Range("A2").Offset(k + i, 0).Select Range("A2", ActiveCell).EntireRow.Delete Shift:=xlUp h = h + 1 Else: i = nb End If Next i Dim xWs As Worksheet Dim xcsvFile As String For Each Scut In Application.ActiveWorkbook.Worksheets Scut.Copy Name = CurDir & "\" & Scut.Name & ".csv" Application.ActiveWorkbook.SaveAs Filename:=Name, _ FileFormat:=xlCSV, CreateBackup:=False Application.ActiveWorkbook.Saved = True Application.ActiveWorkbook.Close Next Application.ScreenUpdating = True End Sub 

Answer 1

我有下一个代码工作：

 Sub ExportFile() Const myDelim As String = "|" Dim Sheet As Object Set Sheet = Worksheets For p = 1 To 2 'you could use sheet.count Sheet(p).Activate Dim ws As Worksheet Set ws = ActiveSheet Dim r As Long, c As Long, i As Long, j As Long r = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row c = ws.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Dim myPath As String myPath = ThisWorkbook.Path & "\" Dim myFile As String filename = ws.name myFile = myPath & filename & ".extention" Dim obj As Object Set obj = CreateObject("ADODB.Stream") obj.Type = 2 obj.Charset = "ASCII" obj.Open Dim v() As Variant ReDim v(1 To c) For i = 3 To r - 1 For j = 1 To c v(j) = ws.Cells(i, j).Text Next obj.WriteText Join(v, myDelim), 1 Next obj.SaveToFile myFile, 2 End Sub 

这将所有表单写入一个文件，用“|”分隔行中的单元格