Question

我正在开发一个VBA代码，可以从源代码创建多个工作表（Sheets）。我正在尝试以CSV格式单独保存它们以将它们用于批量输入。但是，要求是保存的工作表必须在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

这会将所有工作表写入一个文件，用“|”

分隔行中的单元格

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

1 个答案: