Question

所以在我的“sheet1”上我有A，B，C，D，E，F列中的数据

我希望VBA代码将第1（A），第3（C）和第5（E）列合并，并将其保存为逗号分隔的文本文件。

我有：

Option Explicit

Public Sub ExcelRowsToCSV()

 Dim iPtr As Integer
 Dim sFileName As String
 Dim intFH As Integer
 Dim aRange As Range
 Dim iLastColumn As Integer
 Dim oCell As Range
 Dim iRec As Long

 Dim lenth As String


 Set aRange = Range("A1:C11")

 iLastColumn = aRange.Column + aRange.Columns.Count - 1

 iPtr = InStrRev(ActiveWorkbook.FullName, ".")
 sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & ".txt"
 sFileName = Application.GetSaveAsFilename(InitialFileName:=sFileName,  FileFilter:="TXT (Comma delimited) (*.txt), *.txt")
 If sFileName = "False" Then Exit Sub

 Close
 intFH = FreeFile()
 Open sFileName For Output As intFH

 iRec = 0

 For Each oCell In aRange

   If oCell.Column = iLastColumn Then

     Print #intFH, oCell.Value
     iRec = iRec + 1

   Else

     Print #intFH, oCell.Value; ",";
     iRec = iRec + 1

   End If

 Next oCell

 Close intFH

 MsgBox "Finished: " & CStr(iRec) & " records written to " _
 & sFileName & Space(10), vbOKOnly + vbInformation

End Sub

这只有在声明的范围具有彼此相邻的列时才有效。

Answer 1

尝试将每个人更改为:(未经测试，但希望您明白这一点）

dim str as string

 For i= 1 to arange.rows
      str=""
      for j=1 to arange.columns

            str=str & ","

      next
      Print #intFH, str
 Next

Answer 2

最快的方法是将工作表复制为新工作簿，然后删除不必要的列，然后将文件另存为csv。这也不会影响原始文件。

例如（ TRIED AND TESTED ）

Option Explicit

Sub Sample()
    Dim wb As Workbook
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1")

    '~~> Copy the sheet as a new workbook
    ws.Copy

    ActiveSheet.Range("D:D,B:B,F:F").Delete Shift:=xlToLeft
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\Sample.Csv", FileFormat:=xlCSV
    ActiveWorkbook.Close (False)
    Application.DisplayAlerts = True
End Sub

Excel 2013：VBA从X列创建范围并另存为文本文件

2 个答案: