相同格式的多工作簿多工作表求和请教

cqcbc

最近在汇总多个相同格式的工作簿的多工作表的时候，希望将结果累计写入到内部结构一致的汇总工作簿时，调试到以下这一句时出错了，请老师们帮助我，谢谢。
summarySheet.Range(summarySheet.Cells(startRow, startCol), summarySheet.Cells(endRow, endCol)).Value = summarySheet.Range(summarySheet.Cells(startRow, startCol), summarySheet.Cells(endRow, endCol)).Value + currentSheet.Range(currentSheet.Cells(startRow, startCol), currentSheet.Cells(endRow, endCol)).Value

wengjl

我感觉你把问题想复杂了：VBA对自身工作簿的操作简单得多。所以分二步走，第一步将多个工作簿上的表汇总到带宏的工作簿上；第二步进行统计，此时的统计就方便多了。

你能写那么复杂的代码，感觉你的水平比我高！

cqcbc

wengjl 发表于 2023-4-23 08:06
我感觉你把问题想复杂了：VBA对自身工作簿的操作简单得多。所以分二步走，第一步将多个工作簿上的表汇总到 ...

你建议的先提取各表格数据，后期再汇总，是可行的。我现在就是希望一步到位。我是初学者水平。

3190496160

看你的代码不可能弄得清楚你想如何汇总，
目前的代码搞得过于复杂了，有点简单问题复杂化处理的感觉，而且，对于初学者而言，说点个人之见：变量不要搞得这么复杂，一个变量很多个字母，

ykcbf1100

cqcbc 发表于 2023-4-23 08:18
你建议的先提取各表格数据，后期再汇总，是可行的。我现在就是希望一步到位。我是初学者水平。

一步到位是高水平的人才能做到的。
别人总是把复杂问题简单化，你却想把简单问题复杂啊，不可思议的想法啊。
另外，我也同意4楼老师的意见，不要把变量搞那么多长，看着头晕，看你的代码得看半天，顿失写代码的兴趣。

bqwd36

range=range+range改成cells=cells+cells呢

cqcbc

Sub SummarizeWorkbooksData()
    Dim selectedFolder As Object
    Dim queue As New Collection
    ' 选择待汇总求和的工作簿所在的文件夹
    Set selectedFolder = Application.FileDialog(msoFileDialogFolderPicker)
    selectedFolder.AllowMultiSelect = False
    If selectedFolder.Show <> -1 Then Exit Sub
    queue.Add selectedFolder.SelectedItems.Item(1)
    ' 创建汇总工作簿
    Dim summaryWorkbook As Workbook
    Set summaryWorkbook = Workbooks.Add
    ' 遍历队列中的文件夹
    Do While queue.Count > 0
        Dim currentFolder As String
        currentFolder = queue.Item(1)
        queue.Remove 1
        ' 遍历当前文件夹下的所有文件
        Dim currentFile As String
        currentFile = Dir(currentFolder & "\*.*")
        Do While currentFile <> ""
            ' 判断文件类型：只处理xlsx和xls文件
            If Right(currentFile, 4) = ".xlsx" Or Right(currentFile, 4) = ".xls" Then
                Dim currentWorkbook As Workbook
                Set currentWorkbook = Workbooks.Open(currentFolder & "\" & currentFile)
                ' 遍历工作簿中的所有工作表
                Dim currentSheet As Worksheet
                For Each currentSheet In currentWorkbook.Worksheets
                    Dim sheetName As String
                    sheetName = currentSheet.Name
                    ' 在汇总工作簿中查找是否存在相同名称的工作表
                    Dim summarySheet As Worksheet
                    Set summarySheet = Nothing
                    On Error Resume Next
                    Set summarySheet = summaryWorkbook.Worksheets(sheetName)
                    On Error GoTo 0
                    If summarySheet Is Nothing Then
                    ' 如果不存在相同名称的工作表，则在汇总工作簿中新建一个工作表
                        currentSheet.Copy after:=summaryWorkbook.Sheets(summaryWorkbook.Sheets.Count)
                        Set summarySheet = summaryWorkbook.Sheets(summaryWorkbook.Sheets.Count)
                        summarySheet.Name = sheetName
                    Else
                        ' 如果已经存在相同名称的工作表，则将数字求和
                        Dim startRow As Long, startCol As Long, endRow As Long, endCol As Long
                        startRow = currentSheet.UsedRange.Row
                        startCol = currentSheet.UsedRange.Column
                        endRow = currentSheet.UsedRange.Row + currentSheet.UsedRange.Rows.Count - 1
                        endCol = currentSheet.UsedRange.Column + currentSheet.UsedRange.Columns.Count - 1
                        currentSheet.Range(currentSheet.Cells(startRow, startCol), currentSheet.Cells(endRow, endCol)).CurrentRegion.Copy
                        summarySheet.Range(summarySheet.Cells(startRow, startCol), summarySheet.Cells(endRow, endCol)).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
                    End If
                Next currentSheet
                ' 关闭当前工作簿
                currentWorkbook.Close False
            ElseIf (GetAttr(currentFolder & "\" & currentFile) And vbDirectory) = vbDirectory And currentFile <> "." And currentFile <> ".." Then
                ' 如果是文件夹，则将其添加到队列中
                queue.Add currentFolder & "\" & currentFile
            End If
            currentFile = Dir
        Loop
    Loop
End Sub
修改为选择性粘贴，可以累计一个文件夹的了。

谢谢老师们的帮助。