Question

我下面粘贴的代码适用于工作簿中的一个工作表，但我不知道如何遍历工作簿中的代码，以便将其遍历到每个工作表。

有人可以解释一下如何使用此代码的循环功能吗？：）

Sub Rearrange_Columns()
Dim arrColOrder As Variant, ndx As Integer
Dim Found As Range, counter As Integer
arrColOrder = Array("Company", "First Name", "Last Name", "Email", "Category", "Address", "Suite or Unit?", "Suite/Unit", "City", "Province", "Postal Code", "Phone", "Fax", _
"Website", "Service Areas", "Logo", "CONCAT")
counter = 1
Application.ScreenUpdating = False
For ndx = LBound(arrColOrder) To UBound(arrColOrder)
    Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole,SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not Found Is Nothing Then
        If Found.Column <> counter Then
         Found.EntireColumn.Cut
         Columns(counter).Insert Shift:=xlToRight
         Application.CutCopyMode = False
        End If
        counter = counter + 1
     End If
Next ndx
End Sub

Answer 1

您需要的只是遍历工作表，并为每个Rows，Columns，Range等指定工作表

For Each ws In ThisWorkbook.Worksheets
    ws.Rows(…) 'specify the worksheet
Next ws

例如

Option Explicit

Sub RearrangeColumnsInAllWorksheets()
    Dim arrColOrder As Variant
    arrColOrder = Array("Company", "First Name", "Last Name", "Email", "Category", "Address", "Suite or Unit?", "Suite/Unit", "City", "Province", "Postal Code", "Phone", "Fax", "Website", "Service Areas", "Logo", "CONCAT")

    Dim ndx As Long
    Dim Found As Range

    Dim Counter As Long
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets 'loop through all worksheets
        Counter = 1
        For ndx = LBound(arrColOrder) To UBound(arrColOrder)
            Set Found = ws.Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
            If Not Found Is Nothing Then
                If Found.Column <> Counter Then
                    Found.EntireColumn.Cut
                    ws.Columns(Counter).Insert Shift:=xlToRight
                    Application.CutCopyMode = False
                End If
                Counter = Counter + 1
             End If
        Next ndx
    Next ws

    Application.ScreenUpdating = True 'don't forget to turn it on again
End Sub

重新排列所有工作表上的列

1 个答案: