excel 循环的VBA编码

我正在努力使一个代码在工作簿的所有工作表上运行一个for循环。我试着只为一个选项卡实现这个任务，但它还是有效的。下面是代码，你可以看一下。

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

我得到的错误一样，我没有设置必要的变量，我需要激活工作簿的范围。选择工作，甚至我没有声明变量。虽然，对于所有这些我已经这样做，它的工作为一个单一的标签。这里的代码，让你可以看看。
正如你所看到的，我最初定义了带注解的变量，并在if语句中使用了这些变量，但即使是这些变量，我仍然会得到错误。

尽量避免在VBA中使用.Select，因为它通常会导致更多的问题。通常，当人们使用Select时，他们希望获得一个Range对象。尽管许多VBA的方法实际上返回一个Range对象。
在下面的代码中，我重写了第一个If语句，使其只使用Range对象，而不使用Select
另一个注意事项是，将所有粘贴和清除的内容放在一个单独的Sub()中，这样您就可以简单地调用该子函数，而不是在所有If...else语句中重复所有相同的-令人困惑的-代码。
此外-我相信您已经开始这样做了-减少Cells(<some long code>, <some other long code>)语句的数量，并在处理之前将这些Integer/Long值设置为变量，这将使您的代码更加清晰，并且更容易将粘贴和格式化操作分离到单独的Sub()中
看看下面的工作;

Sub testing()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim searchRng As Range
    Dim rng As Range, cpy As Range
    Dim cell As Range
    
    Set wb = ThisWorkbook
 
    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
    For Each ws In wb.Worksheets
    
        Set searchRng = ws.Range("A1:K1")
    
        Set cpy = Sheets(2).Range("N3")
    
        Set LandedCost = searchRng.Find("Landed Cost")
        Set UnitSell = searchRng.Find("Unit Sell")
        Set TotalUnitPrice = searchRng.Find("Total Unit Price")
        Set Profit = searchRng.Find("Profit")
        Set tier2 = searchRng.Find("TIER-2")
        Set NetProfit = searchRng.Find("Net Profit")
        Set Mtrs = searchRng.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
            Set rng = ws.Range(Cells(LandedCost.End(xlDown).Row, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row, TotalUnitPrice.Column))
            
            rng.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _
                :=False, Transpose:=False
            
            Set rng = Application.Union(Columns(LandedCost.Column), Columns(UnitSell.Column), Columns(TotalUnitPrice.Column))
            Application.CutCopyMode = False
            rng.NumberFormat = "[$$-en-US]#,##0.00"
            
            ws.Range(Cells(1, LandedCost.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row, TotalUnitPrice.Column)).ClearContents
                
        '...rest of your if else statements
        
        End If
        
        If Not IsNull(Profit) Then
            Columns(Profit.Column).Select
            cpy.NumberFormat = "[$$-en-US]#,##0.00"
        ElseIf Not IsNull(NetProfit) Then
            Columns(NetProfit.Column).Select
            cpy.NumberFormat = "[$$-en-US]#,##0.00"
        End If
    Next
End Sub

编辑

你的代码，但重构（虽然可以说没有测试，因为我没有你的数据）

Private Function FindRange(ws As Worksheet, arg As String) As Range

    Set FindRange = ws.Range("A1:K1").Find(arg)
    
End Function

Private Sub ClearRange(ws As Worksheet, col1 As Long, col2 As Long)

    Set C1 = ws.Cells(1, col1)
    Set C2 = ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row, col2)
    ws.Range(C1, C2).ClearContents
    
End Sub

    
Sub Testing()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim searchRng As Range
    Dim rng As Range
    Dim cell As Range
    Dim rngUnion As Range
    
    Set wb = ThisWorkbook
 
    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
    For Each ws In ThisWorkbook.Worksheets
        
        Set cpy = Sheets(2).Range("N3")
        cpy.Copy
    
        Set LandedCost = FindRange("Landed Cost")
        Set UnitSell = FindRange("Unit Sell")
        Set TotalUnitPrice = FindRange("Total Unit Price")
        Set Profit = FindRange("Profit")
        Set tier2 = FindRange("TIER-2")
        Set NetProfit = FindRange("Net Profit")
        Set Mtrs = FindRange("Unit Price-Ref Mtrs")
        
        landedCostLastRow = LandedCost.End(xlDown).Row
        landedCostColumn = LandedCost.Column
        last_row = Cells(Rows.Count, 1).End(xlUp).Row
        last_col_cur = Cells(4, Columns.Count).End(xlToLeft).Column - 1 'for currency'
        
        Set C1 = Cells(landedCostLastRow, landedCostColumn)
        Set rngUnion = Application.union(Columns(landedCostColumn), Columns(UnitSell.Column))
    
        If Not IsNull(TotalUnitPrice) Then
            
            Set C2 = Cells(last_row, TotalUnitPrice.Column)
            Set rng = ws.Range(C1, C2)
            rng.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False
                
            Set rngUnion = Application.union(rngUnion, Columns(TotalUnitPrice.Column))
            rngUnion.NumberFormat = "[$$-en-US]#,##0.00"
            
            ClearRange ws, landedCostColumn, TotalUnitPrice.Column
                
        ElseIf Not IsNull(UnitSell) Then
        
            Set C2 = Cells(last_row + 20, UnitSell.Column)
            ws.Range(C1, C2).PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False
            
            rngUnion.NumberFormat = "[$$-en-US]#,##0.00"
            
            ClearRange ws, landedCostColumn, UnitSell.Column
            
        ElseIf Not IsNull(tier2) Then
        
            Set C2 = Cells(last_row + 20, tier2.Column)
            ws.Range(C1, C2).PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False
                
            Set rngUnion = Application.union(rngUnion, Columns(tier2.Column))
            rng.NumberFormat = "[$$-en-US]#,##0.00"
            
            ClearRange ws, landedCostColumn, tier2.Column
            
        ElseIf Not IsNull(Mtrs) Then
        
            Set C2 = Cells(last_row + 20, Mtrs.Column)
            ws.Range(C1, C2).PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False
                
            Set rngUnion = Application.union(rngUnion, Columns(Mtrs.Column))
            rngUnion.NumberFormat = "[$$-en-US]#,##0.00"
            
            ClearRange ws, landedCostColumn, Mtrs.Column
            
        End If
        
        If Not IsNull(Profit) Then
            Columns(Profit.Column).Select
            cpy.NumberFormat = "[$$-en-US]#,##0.00"
        ElseIf Not IsNull(NetProfit) Then
            Columns(NetProfit.Column).Select
            cpy.NumberFormat = "[$$-en-US]#,##0.00"
        End If
    Next
End Sub

excel 循环的VBA编码

1条答案

相关问题

热门标签

最新问答