Excel VBA批量导出到csv 5

时间:2018-05-30 17:11:05

标签: excel-vba vba excel

我正在尝试将一些excel数据以5个数据行和1个标题的批量导出到.csv。

我的第一个文件有4个数据行,应该是5加上标题,如下所示

latitude,longitude,altitude(m),heading(deg),curvesize(m),rotationdir,gimbalmode,gimbalpitchangle,actiontype1,actionparam1
1,-0.5643113,100,0,0,0,2,-90,1,0
2,-0.56499336,100,180,0,0,2,-90,1,0
3,-0.56499336,100,180,0,0,2,-90,1,0
4,-0.56499336,100,180,0,0,2,-90,1,0

其余文件有5个数据行(这是正确的)

latitude,longitude,altitude(m),heading(deg),curvesize(m),rotationdir,gimbalmode,gimbalpitchangle,actiontype1,actionparam1
5,-0.56499336,100,180,0,0,2,-90,1,0
6,-0.56815177,100,0,0,0,2,-90,1,0
7,-0.56815177,100,0,0,0,2,-90,1,0
8,-0.56815177,100,0,0,0,2,-90,1,0
9,-0.56815177,100,0,0,0,2,-90,1,0

我出错的任何想法?

Sub Export()
    Dim FileNum As Integer
    Dim Last_Row As Long
    Dim My_Range As Range
    Dim TotalFileNum As Integer
    Dim myStr As String
    Dim MYFILE As String
    Dim i As Integer
    Dim j As Long

    MYFILE = ThisWorkbook.Path & "\"

    FileNum = FreeFile
    Last_Row = Cells(Rows.Count, 1).End(xlUp).Row
    Set My_Range = ActiveSheet.Range("A2:J" & Last_Row)

    Open MYFILE & "Litch 0.csv" For Output As #FileNum

    'Put out the headers
    myStr = Cells(1, 1).Value
    For i = 2 To 10
        myStr = myStr & "," & Cells(1, i).Value
    Next i
    Print #FileNum, myStr



    For j = 2 To Last_Row
        If (j - 1) Mod 5 = 0 Then
            Close #FileNum
            Open MYFILE & "Litch " & ((j - 1) \ 5) & ".csv" For Output As #FileNum

            'Put out the headers
            myStr = Cells(1, 1).Value
            For i = 2 To 10
                myStr = myStr & "," & Cells(1, i).Value
            Next i
            Print #FileNum, myStr
            TotalFileNum = (j \ 5) + 1
        End If

        'Put out the values
        myStr = Cells(j, 1).Value
        For i = 2 To 10
            myStr = myStr & "," & Cells(j, i).Value
        Next i
        Print #FileNum, myStr

    Next j
    Close #FileNum
End Sub

提前感谢您的帮助

1 个答案:

答案 0 :(得分:0)

也许在循环中做所有事情会更好

Option Explicit

Sub Export()
Dim FileNum As Integer
Dim Last_Row As Long
Dim My_Range As Range
Dim TotalFileNum As Integer
Dim myStr As String
Dim MYFILE As String
Dim i As Integer
Dim j As Long

    MYFILE = ThisWorkbook.Path & "\"    

    Last_Row = Cells(Rows.Count, 1).End(xlUp).Row
    Set My_Range = ActiveSheet.Range("A2:J" & Last_Row)

    For j = 1 To Last_Row

        If j = Last_Row Then
            Close #FileNum
            Exit For
        End If

        If (j - 1) Mod 5 = 0 Then

            FileNum = FreeFile
            Open MYFILE & "Litch " & ((j - 1) \ 5) & ".csv" For Output As #FileNum

            'Put out the headers
            myStr = Cells(1, 1).Value
            For i = 2 To 10
                myStr = myStr & "," & Cells(1, i).Value
            Next i
            Print #FileNum, myStr
            TotalFileNum = (j \ 5) + 1

        End If

        'Put out the values
        myStr = Cells(j + 1, 1).Value
        For i = 2 To 10
            myStr = myStr & "," & Cells(j + 1, i).Value
        Next i

        Print #FileNum, myStr

        If j Mod 5 = 0 Then
            Close #FileNum
        End If

    Next j

End Sub