Question

我正在编写一个宏，它将遍历29个工作表并从中获取数据，以在另一个工作表中构建格式化的估计。我已经计算出了我想在每个工作表上执行的基本代码，但是在for循环中使用它时遇到了麻烦。我怀疑我的问题与数组中的项是字符串数据或错误类型的对象有关。但我一直无法解决它。

更新：我通过遵循下面的答案和评论中的建议解决了以下声明中的初始错误，以删除不必要的阻止。

我改变了这个：

 With WshtNameCrnt
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlValues, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        LastRow = 1

对此：

'Find last row on current worksheet      
 If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow = .Cells.Find(What:="*", _
                        After:=.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlValues, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        Else
            LastRow = 1
        End If

因此解决了这个问题，因为正如YowE3K指出的那样“在一个With块中，使用一个没有前面的对象的。告诉VBA将方法/属性应用于With语句中定义的对象，所以（对于例如，在with xyz块中，代码.Cells被解释为xyz.Cells。“

我在代码中遇到的下一个问题是：

'pull sub-categories from current worksheet tab to estimate page
    est_sht.Range(est_sht.Cells(EstLastRow, 3), est_sht.Cells(NumRows + EstLastRow, 3)).Value = Worksheets(WshtNames(WshtNameCrnt)).Range(WshtNameCrnt.Cells(4, 1), WshtNameCrnt.Cells(LastRow, 1)).Value

我通过删除WshtNameCrnt引用并将语句更改为：

来解决这个问题

'pull sub-categories from current worksheet tab to estimate page
        est_sht.Range(est_sht.Cells(EstLastRow, 3), est_sht.Cells(NumRows + EstLastRow, 3)).Value = .Range(.Cells(4, 1), .Cells(LastRow, 1)).Value

编辑：我在上下文中包含了整个（尚未完善的）宏脚本，并进行了一些小的更改：

Dim answer As Integer
Dim InputPercentage As Integer
Dim ws As Variant
Dim StartTime As Double
Dim SecondsElapsed As Double

'declare other variables
Dim WorkingPercentage As Variant
Dim EstimateDate As Variant
Dim LastRow As Variant
Dim EstLastRow As Variant
Dim NumRows As Integer
Dim rng As Range
Dim SourceRange As Range
Dim fillrange As Range
Dim sheetname As String

'declare worksheet variables'
Dim est_sht As Worksheet

Sub IterateSheets()

'associate worksheet variables with job categories worksheets
Set est_sht = ActiveWorkbook.Sheets("Estimate Report")
'declare other variables

Dim WshtNameCrnt As Variant
Dim WshtNames As Variant

'prompt user whether estimate sheets are completely filled out"
answer = MsgBox("Have you completed the estimate for all relevant labor categories?", vbYesNo + vbQuestion, "Populate Estimate")

If answer = vbYes Then

'prompt user for markup percentage
InputPercentage = Application.InputBox("What deposit percentage would you like to charge?", "Enter a number", , , , , , Type:=1)

'prompt user for date to be displayed on estimate
'EstimateDate = Application.InputBox("What date would you like on the estimate document?  Please enter as MM/DD/YYYY.", "Date")

WorkingPercentage = InputPercentage / 100

'clear out estimate sheet
est_sht.Cells.Clear

'set row height of top accent bar
est_sht.Rows("1:1").RowHeight = 10

'set color of top accent bar
With est_sht.Range("A1:J1").Interior
.Color = vbBlack
End With

'set row 2 height
est_sht.Rows("2:2").RowHeight = 16.5

'set row 3 height
est_sht.Rows("3:3").RowHeight = 130

'set text formatting
With est_sht.Rows("3:3").Font
        .Name = "Arial"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.349986266670736
        .ThemeFont = xlThemeFontMajor
    End With
est_sht.Rows("3:3").Font.Bold = True

'Date stamp the estimate based on form input
est_sht.Cells(3, 3).Value = EstimateDate

'title the estimate
est_sht.Cells(3, 5).Value = "Cost Estimate"

'Insert header row text'
est_sht.Cells(4, 3).Value = "PROJECT TASKS"
est_sht.Cells(4, 4).Value = "Cost Estimate"
est_sht.Cells(4, 5).FormulaR1C1 = InputPercentage & "% Deposit"
est_sht.Cells(4, 6).Value = "Current Costs"

'format header row of first labor subcategory
With est_sht.Range("C4:F4").Font
        .Name = "Arial"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.349986266670736
        .ThemeFont = xlThemeFontMajor
    End With
est_sht.Range("C4:F4").Font.Bold = True

'create variant array of worksheets
WshtNames = Array("permits", "project management", "in progress design", "site prep", "services on site", "layout", "concrete", "water management", "framing", "roofing and sheet metal", "electrical", "plumbing", "HVAC", "windows and doors", "exterior finishes", "insulation", "drywall", "painting", "cabinetry", "countertops", "interior finishes", "flooring", "tile", "deck garden", "landscaping", "appliances", "punchlist", "add-ons", "contingency")

'loop through worksheets
  For WshtNameCrnt = LBound(WshtNames) To UBound(WshtNames)
     With Worksheets(WshtNames(WshtNameCrnt))
        'Debug.Print "Cell B3 of worksheet " & .Name & " contains " & .Range("B3").Value

        'find last row on estimate page
        With est_sht
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                EstLastRow = .Cells.Find(What:="*", _
                            After:=.Range("B1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlValues, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
            Else
                EstLastRow = 1
            End If
        End With

        'add sheet name to table
        est_sht.Cells(EstLastRow + 2, 3).Value = .Name

        'format sub-header
        est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + 2, 6)).Font.Bold = True

        'Find last row on current worksheet
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                LastRow = .Cells.Find(What:="*", _
                            After:=.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlValues, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
            Else
                LastRow = 1
            End If
        Debug.Print "Last row on " & WshtNameCrnt & " is " & LastRow

        'count the number of rows filled with sub-categories'
        NumRows = LastRow - 4

      Debug.Print "Number of rows on " & WshtNameCrnt & " is " & NumRows

        'pull sub-categories from current worksheet tab to estimate page
        est_sht.Range(est_sht.Cells(EstLastRow, 3), est_sht.Cells(NumRows + EstLastRow, 3)).Value = Worksheets(WshtNames(WshtNameCrnt)).Range(WshtNameCrnt.Cells(4, 1), WshtNameCrnt.Cells(LastRow, 1)).Value

        'add sequential numbers next to labor categories on estimate page
        est_sht.Cells(EstLastRow + 2, 2).FormulaR1C1 = "1"
        est_sht.Cells(EstLastRow + 3, 2).FormulaR1C1 = "2"
        Set SourceRange = est_sht.Range(est_sht.Cells(EstLastRow + 2, 2), est_sht.Cells(EstLastRow + 3, 2))
        Set fillrange = est_sht.Range(est_sht.Cells(EstLastRow + 2, 2), est_sht.Cells(EstLastRow + NumRows, 2))
        SourceRange.AutoFill Destination:=fillrange

        'set black fill color in sequential numbers sidebar
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 2), est_sht.Cells(EstLastRow + NumRows, 2)).Interior
        .Color = vbBlack
        End With
        'format text color of sequential numbers
        With est_sht.Range(est_sht.Cells(EstLastRow + 3, 2), est_sht.Cells(EstLastRow + NumRows, 2)).Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
        'format sequential numbers bold
        est_sht.Range(est_sht.Cells(EstLastRow + 3, 2), est_sht.Cells(EstLastRow + NumRows, 2)).Font.Bold = True

        'copy labor cost subtotal to estimate page
        est_sht.Cells(EstLastRow + 2, 4).Value = WshtNameCrnt.Range("F2").Value

        'populate deposit formula in estimate page
        est_sht.Cells(EstLastRow + 2, 5).FormulaR1C1 = "=RC[-1]*" & WorkingPercentage
        'populate sum formula in "current costs" for labor category
        est_sht.Cells(EstLastRow + 2, 6).FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"

        'format table around sub-category items and costs
        est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlDiagonalDown).LineStyle = xlNone
        est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlDiagonalUp).LineStyle = xlNone

        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlInsideHorizontal).LineStyle = xlNone

      End With
  Next WshtNameCrnt

'end of main if/else loop, and end of sub'

Else
    Exit Sub
End If

End Sub

提前感谢您的帮助！

Answer 1

正如Jeeped在评论中所说，“将With WshtNameCrnt更改为With Worksheets(WshtNames(WshtNameCrnt))”。这是必要的，因为WshtNameCrnt只是一个数值而不是一个对象，并且是WshtNames数组的索引。

但是，With块甚至不是必需的。在发生错误时，您在With Worksheets(WshtNames(WshtNameCrnt))块中已经，因此您不需要另外一个。

如果使用一致的缩进，外部With块的存在会变得更加明显：

'create variant array of worksheets
WshtNames = Array("permits", "project management", "in progress design", _
            "site prep", "services on site", "layout", "concrete", "water management", _
            "framing", "roofing and sheet metal", "electrical", "plumbing", "HVAC", _
            "windows and doors", "exterior finishes", "insulation", "drywall", _        
            "painting", "cabinetry", "countertops", "interior finishes", "flooring", _
            "tile", "deck garden", "landscaping", "appliances", "punchlist", "add-ons", _
            "contingency")

'loop through worksheets
For WshtNameCrnt = LBound(WshtNames) To UBound(WshtNames)
    With Worksheets(WshtNames(WshtNameCrnt))

        'find last row on estimate page
        With sh32
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                EstLastRow = .Cells.Find(What:="*", _
                                         After:=.Range("B1"), _
                                         Lookat:=xlPart, _
                                         LookIn:=xlValues, _
                                         SearchOrder:=xlByRows, _
                                         SearchDirection:=xlPrevious, _
                                         MatchCase:=False).Row
            Else
                EstLastRow = 1
            End If
        End With

        'add sheet name to table
        sh32.Cells(EstLastRow + 2, 3).Value = .Name

        'format sub-header
        sh32.Range(sh32.Cells(EstLastRow + 2, 3), sh32.Cells(EstLastRow + 2, 6)).Font.Bold = True

        'Find last row on current worksheet
        'With WshtNameCrnt <-- not needed
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow = .Cells.Find(What:="*", _
                                  After:=.Range("A1"), _
                                  Lookat:=xlPart, _
                                  LookIn:=xlValues, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlPrevious, _
                                  MatchCase:=False).Row
        Else
            LastRow = 1
        End If
        'End With <-- not needed

Answer 2

似乎sh32未启动且应设置为Worksheets(WshtNames(WshtNameCrnt))。无论如何，您应该将代码分解为更小的任务。通过这种方式，您将能够独立测试每段代码。这将大大简化调试。

Option Explicit

Sub Main()
    Dim rw As Long
    Dim ws As Worksheet
    For Each ws In getWorksheets
        With ws
            rw = getLastUsedRow(ws)
            .Cells(rw + 2, 3).Value = .Name
            .Cells(rw + 2, 3).Resize(1, 3).Font.Bold = True
        End With
    Next
End Sub

Function getWorksheets() As Worksheets
    Set getWorksheets = ThisWorkbook.Worksheets(Array("permits", "project management", "in progress design", "site prep", "services on site", "layout", "concrete", "water management", "framing", "roofing and sheet metal", "electrical", "plumbing", "HVAC", "windows and doors", "exterior finishes", "insulation", "drywall", "painting", "cabinetry", "countertops", "interior finishes", "flooring", "tile", "deck garden", "landscaping", "appliances", "punchlist", "add-ons", "contingency"))
End Function

Function getLastUsedRow(ws As Worksheet) As Long
    With ws
        If Application.WorksheetFunction.CountA(.Cells) = 0 Then
            getLastUsedRow = 1
        Else
            getLastUsedRow = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        End If
    End With
End Function

Answer 3

我不认为您将WshtNameCrnt设置为对象，它只是一个包含工作表名称的文本变量。试试这个：

With WorkSheet(WshtNameCrnt)
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlValues, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        LastRow = 1

在变量数组中的所有工作表上执行宏 - 在for循环中引用数组对象

3 个答案: