You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

多工作表循环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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.11 20:31:09