通过检测将数据帧拆分为多个部分,然后写入多个csv?

时间:2016-11-29 11:42:18

标签: r csv dataframe split

我有一张csv,如下图所示。数据是一组单独的表,用空行分隔,我需要在单独的csv文件中。

导入到R之后,我想将数据拆分到各个单独的表中,然后将这些表写入单独的csv文件中。我有使用某种字符串检测的想法,因为“新”表由第一列中的第一个“区域”实例表示。有关如何在R中处理此代码的任何想法?有很多表,不建议手动执行此操作。

看起来也存在截断问题,因为表格需要有不同数量的列,但我不希望摆脱NULL或NA数据应该太难了。

感谢您的帮助。

data

2 个答案:

答案 0 :(得分:0)

您应该将每个不同的表放在最上面的部分。总而言之,您有5个具有不同尺寸的表(表1:11x13;表2:11x9;表3:3x12;表4:10x5;表5:6x7)。将它们并排放在上面(A1:M11; N1:V11等)。表格的标题将在第1行。

library(readxl)
# Use the path returned from getwd() function that is R's working directory
df <- as.data.frame(read_excel("C://Users//User//Documents//Revolution//Your.xlsx"))

然后,您可以将这5个表处理为:

Table1 <- df[,1:13]
Table2 <- df[,14:22]
Table3 <- df[1:3,23:34]
Table4 <- df[1:10,35:39]
Table5 <- df[1:6,40:46]

通过关注来自分配中不同行号的维度,表1中没有任何NANULL值...表5.

答案 1 :(得分:0)

我不认为R是这种事情的正确工具。您应该始终尝试使用基于任务的正确工具。由于您已安装Excel,因此运行此VBA脚本。这将做你想要的。

Sub page_endings()
    Dim i As Long 'how many times for pagebreak
    Dim searchvalue_for_break_after 'value to do pagebreak
    searchvalue_for_break_after = ""
     'column A must be filled in with value break after
     'example row 6, 12, 18, 24 whatever row you want
     'will loop until empty row in column A
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row + 1
        If Range("A" & i).Value = searchvalue_for_break_after Then
             'will add a pagebreak after the row with value break after
            ActiveWindow.SelectedSheets.HPageBreaks.Add before:=Range("A" & i).Offset(1)
        End If
    Next i
    Call Create_Separate_Sheet_For_Each_HPageBreak
End Sub


Sub Create_Separate_Sheet_For_Each_HPageBreak()

    Dim HPB As HPageBreak
    Dim RW As Long
    Dim PageNum As Long
    Dim Asheet As Worksheet
    Dim Nsheet As Worksheet
    Dim Acell As Range

    'Sheet with the data, you can also use Sheets("Sheet1")
    Set Asheet = ActiveSheet

    If Asheet.HPageBreaks.Count = 0 Then
        MsgBox "There are no HPageBreaks"
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'When the macro is ready we return to this cell on the ActiveSheet
    Set Acell = Range("A1")

    'Because of this bug we select a cell below your data
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
    Application.Goto Asheet.Range("A" & Rows.Count), True

    RW = 1
    PageNum = 1

    For Each HPB In Asheet.HPageBreaks
        'Add a sheet for the page
        With Asheet.Parent
            Set Nsheet = Worksheets.Add(after:=.Sheets(.Sheets.Count))
        End With

        'Give the sheet a name
        On Error Resume Next
        Nsheet.Name = "Page " & PageNum
        If Err.Number > 0 Then
            MsgBox "Change the name of : " & Nsheet.Name & " manually"
            Err.Clear
        End If
        On Error GoTo 0

        'Copy the cells from the page into the new sheet
        With Asheet
            .Range(.Cells(RW, "A"), .Cells(HPB.Location.Row - 1, "K")).Copy _
                    Nsheet.Cells(1)
        End With
        ' If you want to make values of your formulas use this line also
        ' Nsheet.UsedRange.Value = Nsheet.UsedRange.Value

        RW = HPB.Location.Row
        PageNum = PageNum + 1
    Next HPB

    Asheet.DisplayPageBreaks = False
    Application.Goto Acell, True

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Call SaveWorksheetsAsCsv
End Sub


Sub SaveWorksheetsAsCsv()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "C:\Users\Excel\Desktop\"
For Each WS In ThisWorkbook.Worksheets
    Sheets(WS.Name).Copy
    ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
    ThisWorkbook.Activate
Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub