在variables数组中的所有工作表上执行macros – 引用for循环中的数组对象
我正在编写一个macros，它将循环访问29个工作表，并从中获取数据以在另一个工作表中构build一个格式化的估计值。 我已经计算出了每个工作表上要执行的基本代码，但是在for循环中却遇到了麻烦。 我怀疑我的问题与数组中的项是string数据还是错误的对象types有关。 但是我一直无法解决它。
更新：我解决了下面的声明中的初始错误，按照下面的答案和意见中的build议删除不必要的块。
我改变了这个：
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语句中定义的对象，所以（例如）在a用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
编辑：我包括整个（尚未抛光）的macros脚本的上下文与我做了一些小的改变：
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
提前感谢任何帮助！
正如Jeeped在评论中所说：“ With WshtNameCrnt更改为With Worksheets(WshtNames(WshtNameCrnt)) ”。 这是必要的，因为WshtNameCrnt只是一个数字值，而不是对象，并且是WshtNames数组的索引。
但是，这个块并不是必需的。 在出现错误的位置，您已经在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
看起来sh32没有启动，它应该被设置为Worksheets(WshtNames(WshtNameCrnt)) 。 无论如何，你应该把你的代码分解成更小的任务。 这样，你将能够独立地testing每段代码。 这将大大简化debugging。
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
我不认为你设置WshtNameCrnt作为一个对象，它只是一个文本variables保存工作表名称。 尝试这个：
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