时间戳

首页 > 解决方案 > Excel VBA 以 5 个批次导出到 csv

excel - Excel VBA 以 5 个批次导出到 csv

问题描述

我正在尝试将一些 excel 数据分批导出到 .csv，每行 5 个数据行加上 1 个标题。

我的第一个文件有 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

在此先感谢您的帮助

标签： excelvba

解决方案

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

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

推荐阅读