☰

R studio、Excel、XLS 文件

tag-icon • tag-icon microsoft-excel vba r power-query rstudio
R studio、Excel、XLS 文件

我有 20 个 excel (.XLS) 文件。每个 excel 包含 13 个工作表。所有这些 excel 都采用正确的格式。我想从每个 excel 中提取工作表编号 10，并将数据粘贴到 Excel 工作表中。我希望将每个工作表中的数据放在一个 excel 中。我一直在尝试使用 R 或 R studio 来完成这样的任务。如果有人能帮助我从 R studio 或通过 Excel Power Query 或 VBA 完成这项工作，那将对我很有帮助。

附件是我想要从中提取数据的一张表的表格。我们可以看到，从第 27 行开始有男性行，第 44 行之后也有类似的女性数据。男性、女性和总数的数据结构相同。

在此处输入图片描述

答案1

这需要 VBA。

以下 VBA 宏基于文章 Excel 宏：从多个 Excel 文件中提取数据（4 种方法），您将在其中找到有关代码的更多解释。

警告：我还没有测试过这段代码，这个任务留给你了。

Sub ExtractDataToDifferentSheets()
    On Error GoTo HandleError
    Application.ScreenUpdating = False
    Dim objectFlieSys As Object
    Dim objectGetFolder As Object
    Dim file As Object
    Set objectFlieSys = CreateObject("Scripting.FileSystemObject")
    Set objectGetFolder = objectFlieSys.GetFolder("D:\saledata")       ' The folder location of the source files.
    Dim counter As Integer
    counter = 1
    For Each file In objectGetFolder.Files
        Dim sourceFiles As Workbook
        Set sourceFiles = Workbooks.Open(file.Path, True, True)
        Dim rowsNumber As Integer
        rowsNumber = sourceFiles.Worksheets(10).UsedRange.rows.Count
        Dim colsNumber As Integer
        colsNumber = sourceFiles.Worksheets(10).UsedRange.Columns.Count
        Dim rows, cols As Integer
        For rows = 1 To rowsNumber
            For cols = 1 To colsNumber
                Application.Workbooks(counter).ActiveSheet.Cells(rows, cols) = _
                       sourceFiles.Worksheets(10).Cells(rows, cols)
            Next cols
        Next rows
        rows = 0
        Dim worksheetName As String
        worksheetName = Replace(sourceFiles.Name, ".xlsx", "")
        sourceFiles.Close False
        Set sourceFiles = Nothing
        With ActiveWorkbook
            .ActiveSheet.Name = worksheetName
            counter = counter + 1
            If counter > .Worksheets.Count Then
                .Sheets.Add After:=.Worksheets(.Worksheets.Count)
            End If
            .Worksheets(counter).Activate
        End With
    Next
HandleError:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

相关内容