多工作表循环VBA代码报错求助:单表正常多表运行失败
遍历工作簿工作表的VBA代码批量运行错误排查与修复
我编写了一段遍历工作簿所有工作表的VBA循环代码,仅针对单个工作表运行时功能正常,但批量遍历所有工作表时出现多种错误,包括未设置必要变量、需激活工作簿才能使用Range.Select、未声明变量等。已尝试声明相关变量、设置变量,甚至启用注释里的变量仍无法解决问题,原代码如下:
Sub testing() Dim LandedCost As Range Dim UnitSell As Range Dim TotalUnitPrice As Range Dim Profit As Range Dim tier2 As Range Dim Mtrs As Range Dim NetProfit As Range Dim last_row As Long Dim first_col As Range Dim last_col As Range Dim last_col_cur As Range y = ThisWorkbook.Sheets.Count For i = 2 To y Sheets(2).Range("N3").Select Selection.Copy Set LandedCost = Sheets(i).Range("A1:K1").Find("Landed Cost") Set UnitSell = Sheets(i).Range("A1:K1").Find("Unit Sell") Set TotalUnitPrice = Sheets(i).Range("A1:K1").Find("Total Unit Price") Set Profit = Sheets(i).Range("A1:K1").Find("Profit") Set tier2 = Sheets(i).Range("A1:K1").Find("TIER-2") Set NetProfit = Sheets(i).Range("A1:K1").Find("Net Profit") Set Mtrs = Sheets(i).Range("A1:K1").Find("Unit Price-Ref Mtrs") 'first_col = LandedCost.Column 'last_col = TotalUnitPrice.Column 'last_row = Cells(Rows.Count, 1).End(xlUp).Row 'last_col_cur = Cells(4, Columns.Count).End(xlToLeft).Column - 1 'for currency' If Not IsNull(TotalUnitPrice) Then Sheets(i).Range(Cells(LandedCost.End(xlDown).Row,LandedCost.Column),Cells(Cells(Rows.Count, 1).End(xlUp).Row, TotalUnitPrice.Column)).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _ :=False, Transpose:=False Application.Union(Columns(LandedCost.Column), Columns(UnitSell.Column), Columns(TotalUnitPrice.Column)).Select Application.CutCopyMode = False Selection.NumberFormat = "[$$-en-US]#,##0.00" Dim cell As Range For Each cell In Sheets(i).Range(Cells(1, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row, TotalUnitPrice.Column)) If cell = 0 Then cell.ClearContents Next cell ElseIf Not IsNull(UnitSell) Then Sheets(i).Range(Cells(LandedCost.End(xlDown).Row, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 20, UnitSell.Column)).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _ :=False, Transpose:=False Application.Union(Columns(LandedCost.Column), Columns(UnitSell.Column)).Select Application.CutCopyMode = False Selection.NumberFormat = "[$$-en-US]#,##0.00" For Each cell In Sheets(i).Range(Cells(1, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row, UnitSell.Column)) If cell = 0 Then cell.ClearContents Next cell ElseIf Not IsNull(tier2) Then Sheets(i).Range(Cells(LandedCost.End(xlDown).Row, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 20, tier2.Column)).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _ :=False, Transpose:=False Application.Union(Columns(LandedCost.Column), Columns(UnitSell.Column), Columns(tier2.Column)).Select Application.CutCopyMode = False Selection.NumberFormat = "[$$-en-US]#,##0.00" For Each cell In Sheets(i).Range(Cells(1, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row, tier2.Column)) If cell = 0 Then cell.ClearContents Next cell ElseIf Not IsNull(Mtrs) Then Sheets(i).Range(Cells(LandedCost.End(xlDown).Row, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 20, Mtrs.Column)).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _ :=False, Transpose:=False Application.Union(Columns(LandedCost.Column), Columns(UnitSell.Column), Columns(Mtrs.Column)).Select Application.CutCopyMode = False Selection.NumberFormat = "[$$-en-US]#,##0.00" For Each cell In Sheets(i).Range(Cells(1, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Mtrs.Column)) If cell = 0 Then cell.ClearContents Next cell End If If Not IsNull(Profit) Then Columns(Profit.Column).Select Selection.NumberFormat = "[$$-en-US]#,##0.00" ElseIf Not IsNull(NetProfit) Then Columns(NetProfit.Column).Select Selection.NumberFormat = "[$$-en-US]#,##0.00" End If Next i End Sub
问题根源与修复方案
- 强制变量声明:添加
Option Explicit到代码开头,强制声明所有变量(如i、y),避免隐式变量导致的错误。 - 限定Range父对象:所有
Cells、Columns操作必须明确指定所属工作表(ws.Cells、ws.Columns),防止默认指向激活工作表引发的跨表错误。 - 正确判断Range是否找到:用
Not ... Is Nothing替代IsNull判断查找结果,因为Range对象未找到时返回Nothing而非Null。 - 移除Select/Selection操作:直接操作Range对象,无需选中,既避免激活工作表的要求,又提升代码运行效率。
- 处理可能的空Range:在使用
LandedCost等Range前,先判断是否不为Nothing,避免“未设置对象变量”错误。
修正后的代码
Option Explicit Sub testing() Dim ws As Worksheet Dim copySource As Range Dim LandedCost As Range Dim UnitSell As Range Dim TotalUnitPrice As Range Dim Profit As Range Dim tier2 As Range Dim Mtrs As Range Dim NetProfit As Range Dim last_row As Long Dim targetRange As Range Dim cell As Range ' 设置复制源,避免重复查找 Set copySource = ThisWorkbook.Sheets(2).Range("N3") copySource.Copy ' 遍历从第2个开始的工作表 For Each ws In ThisWorkbook.Sheets If ws.Index >= 2 Then ' 查找各表头,指定精确匹配 Set LandedCost = ws.Range("A1:K1").Find("Landed Cost", LookIn:=xlValues, LookAt:=xlWhole) Set UnitSell = ws.Range("A1:K1").Find("Unit Sell", LookIn:=xlValues, LookAt:=xlWhole) Set TotalUnitPrice = ws.Range("A1:K1").Find("Total Unit Price", LookIn:=xlValues, LookAt:=xlWhole) Set Profit = ws.Range("A1:K1").Find("Profit", LookIn:=xlValues, LookAt:=xlWhole) Set tier2 = ws.Range("A1:K1").Find("TIER-2", LookIn:=xlValues, LookAt:=xlWhole) Set NetProfit = ws.Range("A1:K1").Find("Net Profit", LookIn:=xlValues, LookAt:=xlWhole) Set Mtrs = ws.Range("A1:K1").Find("Unit Price-Ref Mtrs", LookIn:=xlValues, LookAt:=xlWhole) ' 先判断LandedCost是否存在,避免后续错误 If Not LandedCost Is Nothing Then last_row = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' 按优先级处理不同的表头情况 If Not TotalUnitPrice Is Nothing Then Set targetRange = ws.Range(ws.Cells(LandedCost.End(xlDown).Row, LandedCost.Column), _ ws.Cells(last_row, TotalUnitPrice.Column)) targetRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False ' 设置数字格式 Union(ws.Columns(LandedCost.Column), ws.Columns(UnitSell.Column), ws.Columns(TotalUnitPrice.Column)).NumberFormat = "[$$-en-US]#,##0.00" ' 清除0值单元格 For Each cell In targetRange If cell.Value = 0 Then cell.ClearContents Next cell ElseIf Not UnitSell Is Nothing Then Set targetRange = ws.Range(ws.Cells(LandedCost.End(xlDown).Row, LandedCost.Column), _ ws.Cells(last_row + 20, UnitSell.Column)) targetRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False Union(ws.Columns(LandedCost.Column), ws.Columns(UnitSell.Column)).NumberFormat = "[$$-en-US]#,##0.00" For Each cell In ws.Range(ws.Cells(1, LandedCost.Column), ws.Cells(last_row, UnitSell.Column)) If cell.Value = 0 Then cell.ClearContents Next cell ElseIf Not tier2 Is Nothing Then Set targetRange = ws.Range(ws.Cells(LandedCost.End(xlDown).Row, LandedCost.Column), _ ws.Cells(last_row + 20, tier2.Column)) targetRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False Union(ws.Columns(LandedCost.Column), ws.Columns(UnitSell.Column), ws.Columns(tier2.Column)).NumberFormat = "[$$-en-US]#,##0.00" For Each cell In ws.Range(ws.Cells(1, LandedCost.Column), ws.Cells(last_row, tier2.Column)) If cell.Value = 0 Then cell.ClearContents Next cell ElseIf Not Mtrs Is Nothing Then Set targetRange = ws.Range(ws.Cells(LandedCost.End(xlDown).Row, LandedCost.Column), _ ws.Cells(last_row + 20, Mtrs.Column)) targetRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False Union(ws.Columns(LandedCost.Column), ws.Columns(UnitSell.Column), ws.Columns(Mtrs.Column)).NumberFormat = "[$$-en-US]#,##0.00" For Each cell In ws.Range(ws.Cells(1, LandedCost.Column), ws.Cells(last_row, Mtrs.Column)) If cell.Value = 0 Then cell.ClearContents Next cell End If End If ' 设置利润列格式 If Not Profit Is Nothing Then ws.Columns(Profit.Column).NumberFormat = "[$$-en-US]#,##0.00" ElseIf Not NetProfit Is Nothing Then ws.Columns(NetProfit.Column).NumberFormat = "[$$-en-US]#,##0.00" End If End If Next ws Application.CutCopyMode = False End Sub
内容的提问来源于stack exchange,提问作者Konstantinos Azas
相关产品推荐
相关产品推荐

