Question

我有多个工作簿和多个工作表。我在新工作簿中编写了一个代码。所有工作簿都有相同的格式。我需要在一个新的工作簿中为多个单元格求和。请帮我一个代码。我得到了一个下标超出范围错误。我没有任何编码经验。

Private Sub Intra_Group_Exp1()
    Dim i As Integer
    Dim fileName As String
    Const FOLDER As String = "C:\Sushant_Files\"
    On Error GoTo ErrorHandler

    fileName = Dir(FOLDER, vbDirectory)
    Do While Len(fileName) > 0

        If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then
            i = i + 1
            Dim currentWkbk As Excel.Workbook
            Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
            Dim P As Integer
            Dim q As Integer

            For P = 10 To 32
                For q = 2 To 19
                    ThisWorkbook.Worksheets("Intra Group_Exp").Cells("p,q").Value = ThisWorkbook.Worksheets("Intra Group_Exp").Cells("p,q").Value + currentWkbk.Sheets("Intra Group_Exp").Cells("p,q:p,q").Value
                Next q
            Next P
            currentWkbk.Close
        End If
        fileName = Dir
    Loop
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

Answer 1

您的主要错误如下：您应该处理worksheet.Cells(p, q)而不是worksheet.Cells("p, q")等单元格。后者遍历字符串p, q而不是变量的内容！

说到这一点，使用选项Values和Add简单地使用.PasteSpecial要好得多。见post

所以试试这段代码：

Option Explicit

Private Sub Intra_Group_Exp1()
    Const FOLDER As String = "C:\Sushant_Files\"
    Const cStrWSName As String = "Intra Group_Exp"
    Const cStrRangeAddress As String = "B10:S32"

    Dim rngTarget As Range
    Dim wbSource As Workbook

    Dim fileName As String

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set rngTarget = ThisWorkbook.Worksheets(cStrWSName).Range(cStrRangeAddress)

    fileName = Dir(FOLDER, vbDirectory)
    Do While Len(fileName) > 0

        If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then

            Set wbSource = Workbooks.Open(FOLDER & fileName)

            wbSource.Worksheets(cStrWSName).Range(cStrRangeAddress).Copy
            rngTarget.PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd

            wbSource.Close
        End If
        fileName = Dir
    Loop

ProgramExit:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

正如您所看到的，我添加了一些其他改进，希望它有所帮助！： - ）

使用多个工作表对多个工作簿中的值求和

1 个答案: