重新排列列和将范围导出到CSV

时间:2018-07-01 12:00:47

标签: excel vba excel-vba

我有一组从SQL Server下载的数据。数据可能非常庞大。在将其导出为CSV或XLSX之前,我需要将其重新排列为特定的列顺序模板,真的没关系。

在这种情况下,我整理了一个代码,将原始数据(从Col A到Co; Q并将它们设置在从Col T到Col AB的同一工作表中),然后尝试导出该范围(T: AB到最后一行)作为CSV。

代码的第一部分工作简单明了。但是,我正在努力将范围导出到CSV或XLSX。目前,它仅将数据导出到第1行中的另一个文件中。

代码

Sub test()
Dim LR As Long
Dim myCSVFileName As String
Dim myWB As Workbook
Dim rngToSave As range
Dim fNum As Integer
Dim csvVal As String
LR = Sheets("AAP").Cells(Rows.count, "A").End(xlUp).row

Sheets("AAP").range("T2:T" & LR).Value = Sheets("AAP").range("B2:B" & LR).Value
Sheets("AAP").range("U2:U" & LR).Value = Sheets("AAP").range("C2:C" & LR).Value
Sheets("AAP").range("V2:V" & LR).Value = Sheets("AAP").range("I2:I" & LR).Value
Sheets("AAP").range("W2:W" & LR).Value = Sheets("AAP").range("J2:J" & LR).Value
Sheets("AAP").range("X2:X" & LR).Value = Sheets("AAP").range("E2:E" & LR).Value
Sheets("AAP").range("Y2:Y" & LR).Value = Sheets("AAP").range("F2:F" & LR).Value
Sheets("AAP").range("Z2:Z" & LR).Value = Sheets("AAP").range("H2:H" & LR).Value
Sheets("AAP").range("AA2:AA" & LR).Value = Sheets("AAP").range("G2:G" & LR).Value
Sheets("AAP").range("AB2:AB" & LR).Value = "AA_FEES"

Set myWB = ThisWorkbook
myCSVFileName = myWB.Path & "\" & "CSV-Exported-File-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
csvVal = ""
fNum = FreeFile
Set rngToSave = range("T2:AB" & LR)

Open myCSVFileName For Output As #fNum

For i = 1 To rngToSave.Rows.count
    For j = 1 To rngToSave.Columns.count
        csvVal = csvVal & Chr(34) & rngToSave(i, j).Value & Chr(34) & ","
    Next
    Print #fNum, Left(csvVal, Len(csvVal) - 2)
    csvVal = ""
Next

Close #fileNumber

End Sub

任何人都建议如何提高效率。

1 个答案:

答案 0 :(得分:4)

将其导出到CSV的最简单方法是将工作表复制到无目的地。这将创建一个新的工作簿,即新的ActiveWorkbook,并带有一个原始工作表的副本。删除A:S列后,另存为xlCSV。

...
workSheets("AAP").copy
with activeworkbook
    application.displayalerts = false
    .worksheets(1).range("A:S").entirecolumn.delete
    .saveas filename:=myCSVFileName, fileformat:=xlcsv
    .close savechanges:=false
    application.displayalerts = true
end with