2016-11-29 57 views
1

我有一個csv,如下圖所示。這些數據是一組獨立的表格,由一個空行分隔,我需要將它們放在單獨的csv文件中。通過檢測將數據幀拆分爲多個部分,然後寫入多個csv?

在導入到R之後,我想將數據拆分到各個單獨的表中,然後將這些表寫入單獨的csv文件。我有使用某種類型的字符串檢測的想法,因爲「新」表由第一列中的「區域」的第一個實例表示。有關如何在R中處理此代碼的任何想法?有一堆表,手動這樣做是不可取的。

看起來也有一個截斷問題,因爲這些表需要有不同數量的列,但是我不認爲擺脫NULL或NA數據應該太困難了。

感謝您的任何幫助。

data

+0

仍然不清楚分裂的基礎 –

+0

@ joel.wilson我想拆分圖像中的不同表格。 – Rowley058

+0

你能以csv的形式分享這個例子嗎? – Jacob

回答

0

你應該把每個不同的表最上面的部分。總而言之,您有5個不同尺寸的表格(表格1:11x13;表格2:11x9;表格3:3x12;表格4:10x5;表格5:6x7)。並排在上面(A1:M11; N1:V11等)。表格的標題將在第一行。

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] 

通過關愛尺寸從不同的行號梗在assignmets,你不面對任何表1或NA價值NULL ...表5。

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