Excel 2013:VBA创建从X到X的范围内的列数，并另存为文本文件

因此，在我的“表1”中，我有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

---

这是可行的，但只有在声明的范围中列彼此相邻时才有效。

尝试将for each更改为：（未经测试，但希望您能理解）

---

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

例如（经过尝试和测试）

---

行：Set aRange=Range（“A1:C10”）工作并获取前3列，但如果我将其更改为aRange=Range（“A1:A10”，“C1:C10”）并尝试仅捕获这两列，则无法正常工作。这非常接近，可能我遗漏了一些内容，但Sample.Csv是原始数据集的副本，原始数据集删除了这些列。我将更多地使用它，但这太棒了。这段代码需要在原始工作表的模块中。它将从该工作簿复制sheet1，并创建一个新工作簿，其中的列将被删除。它不会从原始工作表中删除列。我试过并测试了代码。是的，我放错了位置。现在工作得很出色！谢谢

dim str as string

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

            str=str & ","

      next
      Print #intFH, str
 Next

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