在Excel VBA

时间:2016-08-23 14:56:48

标签: excel excel-vba vba

我使用帖子Create text Files from every row in an Excel spreadsheet中的宏为Excel表格中的每一行创建单独的文件。输出文件在每个值后面创建一个空行。是否可以修改此代码,以便在保存文件之前删除空行?

Sub SaveRowsAsCSV()

Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim r As Long, c As Long

Set wsSource = ThisWorkbook.Worksheets("CSV_Template_Data")

Application.DisplayAlerts = False

r = 1
Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
    ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
    Set wsTemp = ThisWorkbook.Worksheets(1)

    For c = 2 To 142
        wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
    Next c

    wsTemp.Move
    Set wbNew = ActiveWorkbook
    Set wsTemp = wbNew.Worksheets(1)
    wbNew.SaveAs "C:\Datasets\" & r & "_Well.csv", xlCSV
    wbNew.Close
    ThisWorkbook.Activate
    r = r + 1
Loop

Application.DisplayAlerts = True

End Sub

1 个答案:

答案 0 :(得分:0)

Adding code to delete each empty row certainly works. changing:

wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value

to

wsTemp.Cells((c) - 1, 1).Value = wsSource.Cells(r, c).Value

and then adding On Error Resume Next appears to work as well.