Question

我在工作簿中有六张纸，而在2张纸上我有40列，其他四张纸我有44列，所以当我合并所有纸张的价值不合适时，所以首先我计划重新排列列中的所有工作表，在我的原始数据中标题从第11行开始，所以在代码本身我删除前10行，然后我的标题将从第一行开始，在我的下面代码行被删除所有工作表但是列在第一张工作表中重新排列，只有其他工作表列位于同一位置。任何人都可以帮我解决这个问题。

提前致谢。

供参考，请在下面找到我的代码。

Sub gram_em()
Dim ws As Worksheet, xWs As Worksheet
 strFile = Application.GetOpenFilename
  Application.Workbooks.Open (strFile)

For Each ws In Sheets
 If ws.Visible Then ws.Select (False)
Next

Set xWs = ActiveSheet
Rows("1:10").Select    
Selection.Delete    
Range("A1").Select    
xWs.Select

Set xWs = ActiveSheet    
Range("A1").Select
arrColOrder = Array("BA ID", "BA Name", "Project Number", "Project 
Name", "Service Month", "Last Action Perfromed by")
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
xWs.Select
Application.ScreenUpdating = True   
End Sub

Answer 1

假设你的逻辑是合理的，试试这个。它扩展了循环。请注意，您无需选择任何内容。

Sub gram_em()

Dim ws As Worksheet, wb As Workbook, Found as Range, ndx as Long, counter as Long

strFile = Application.GetOpenFilename
Set wb = Application.Workbooks.Open(strFile)
arrColOrder = Array("BA ID", "BA Name", "Project Number", "Project Name", "Service Month", "Last Action Perfromed by")

Application.ScreenUpdating = False

For Each ws In wb.Sheets
    If ws.Visible Then
        ws.Rows("1:10").Delete
        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
                End If
                counter = counter + 1
            End If
        Next ndx
    End If
Next ws

Application.ScreenUpdating = True

End Sub

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

1 个答案: