vba - 需要帮助更正嵌套在循环中的子例程中的 'with' 语句

Question

下面是我一直在研究的一个宏，它使用名为“BW TB”的主工作表中的数据更新所有“数字”工作表(即具有数字名称的工作表)中的一组值。

由于某种原因，子例程“ClearContents”清除了所有数字表中的数据，但也清除了主表中的数据(因此使用其他两个子例程没有复制粘贴)，我不知道为什么!完整的代码如下；请看一下:

Option Explicit

Dim BW As String, FirstRow As Integer, LastRow As Integer, ColNo As Integer, i As Integer

Sub Refresh_Data()

    Application.CutCopyMode = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Defines the range of rows and columns in the refreshed BW query
    BW = "BW TB"
    Worksheets(BW).Activate
    Range("A1").Activate

    Dim MyCell As Range
    Set MyCell = Cells.Find(What:="Overall Result", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
    True, SearchFormat:=False)
    FirstRow = MyCell.End(xlUp).Row + 1
    LastRow = MyCell.Row - 1
    ColNo = MyCell.Column

    'loop to update numeric sheets
    For i = 1 To Sheets.Count
    If IsNumeric(Sheets(i).Name) Then
        Call Clearcontents
        Call PasteGLCodes
        Call PasteTBValues
    End If
    Next

    Call CheckTotals

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub


Private Sub Clearcontents()

'clears the contents of the sheet of Row 6 to 1000 for every column containing data in Row 6
Dim ColRange As Integer
With Worksheets(i)
    ColRange = .Cells(6, .Columns.Count).End(xlToLeft).Column
    .Range("A6", .Cells(1000, ColRange)).Clearcontents
End With    
End Sub

Private Sub PasteGLCodes()

'Pastes the range of GL codes from ColumnA
With Worksheets(BW)
    Range(.Cells(FirstRow, ColNo), .Cells(LastRow, ColNo)).Copy
End With
Worksheets(i).Range("A5").PasteSpecial xlPasteValues

End Sub

Private Sub PasteTBValues()

'Copies the formula from top row and drags to the last row
Range("B5:L5").Copy
Range("B5:L5", Range("B5:L5").Offset(LastRow - FirstRow, 0)).PasteSpecial xlPasteFormulas

'Recalculates the formulae
ActiveSheet.Calculate

'Pastes the values from the second row down to the last row
Range("B6:L6", Range("B6:L6").Offset(LastRow - FirstRow, 0)).Copy
Range("B6").PasteSpecial xlPasteValues

End Sub

Private Sub CheckTotals()

Application.Goto Worksheets("Control sheet").Range("AU114"), True
MsgBox "Update complete - check control totals"

End Sub

如果我将 ClearContents 替换为:

Private Sub Clearcontents()

    Sheets(i).Activate
    Range("A6").EntireRow.Select
    Range(Selection, Selection.Offset(1000, 0)).Clearcontents

End Sub

它工作正常，但它显然是一个不太干净的解决方案。

一如既往，非常感谢任何帮助!

Answer 1

尝试改变
.Range("A6", .Cells(1000, ColRange)).Clearcontents
至
.Range(.Range("A6"), .Cells(1000, ColRange)).Clearcontents
在您的 Clearcontents 子中。

编辑 我看到了你的问题:Clearcontents也不是 PasteGLCodes激活第 i 个工作表，以便您调用 PasteTBValues将始终在您在运行开始时激活的工作表上运行(“BW TB”)。您需要更改最后一个子，以便它在第 i 个工作表上运行...