excel VBA对不同工作簿或工作表中的列重新排序

nlejzf6q  于 2023-02-05  发布在  其他
关注(0)|答案(1)|浏览(365)

我尝试重新排序列标题和它们的数据与另一个数据集与正确的顺序。所以,我尝试从坏:“a,c,d,b”到好:“a,b,c,d”与他们的标题+数据,然后粘贴到一个空白工作表,固定。代码运行,但它不打印出值在新的工作表。列长度的数据是一个不同的长度,所以额外的标题将被放置在最后。

Option Explicit

Sub OrderColumns()
    
    Dim ws As Worksheet, gws As Worksheet, bws As Worksheet, header As String
    Dim gcols As Long, bcols As Long, c As Range, i As Long, fcol As Long

    Set gws = Worksheets("Good Columns")
    Set bws = Worksheets("Bad Columns")
    
     gcols = gws.Range("MD1").End(xlToLeft).Column
     bcols = bws.Range("MD1").End(xlToLeft).Column
    
    With ThisWorkbook
        Set ws = .Sheets.Add(Before:=.Sheets(.Sheets.Count))
        ws.Name = "Fixed"
    End With
    
    fcol = 1
    
    For i = 1 To gcols
        
        header = gws.Cells(1, i)
        
            With bws
            Set c = Range(Cells(1, 1), Cells(1, bcols)).Find(header, LookIn:=xlValues, lookat:=xlWhole)
            End With
            
            If (Not c Is Nothing) Then
                Cells(1, c.Column).EntireColumn.Copy Sheets("Fixed").Cells(1, bcols)
                fcol = fcol + 1
            End If

    Next i
    
End Sub

因为我没有定义变量沿着使用select语句,所以这段代码是这样写的:

Sub Rearange_Column_Order()

    Sheets("Bad Columns").Select
    i = Sheets("Bad Columns").Index
    
    Sheets.Add
    Sheets(i).Name = "Fixed"
    
    gcols = Sheets("Good Columns").Range("IV1").End(xlToLeft).Column
    bcol = Sheets("Bad Columns").Range("IV1").End(xlToLeft).Column
    
    fcol = 1
    
    For i = 1 To gcols
        header = Sheets("Good Columns").Cells(1, i)
        Sheets("Bad Columns").Select
        Set c = Range(Cells(1, 1), Cells(1, bcol)).Find(header, LookIn:=xlValues, lookat:=xlWhole)
        If (Not (c) Is Nothing) Then
            Cells(1, c.Column).EntireColumn.Copy Sheets("Fixed").Cells(1, fcol)
            fcol = fcol + 1
        End If
    Next i
End Sub
u4dcyp6a

u4dcyp6a1#

试试这样的方法:

Sub OrderColumns()
    
    Dim ws As Worksheet, gws As Worksheet, bws As Worksheet, header As String
    Dim gcols As Range, bcols As Range, c As Range
    Dim wb As Workbook, f As Range, pasteDest As Range
    
    Set wb = ThisWorkbook 'use a specific workbook for all sheets...
    Set gws = wb.Worksheets("Good Columns")
    Set bws = wb.Worksheets("Bad Columns")
    
    Set ws = wb.Sheets.Add(Before:=wb.Sheets(wb.Sheets.Count))
    ws.name = "Fixed"
    
    Set gcols = gws.Range("A1", gws.Cells(1, Columns.Count).End(xlToLeft))
    Set bcols = bws.Range("A1", bws.Cells(1, Columns.Count).End(xlToLeft))
    
    Set pasteDest = ws.Range("A1") 'start pasting here
    For Each c In gcols 'loop over "good" headers
        'find in "bad" headers
        Set f = bcols.Find(what:=c.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            'if found, copy whole column
            f.EntireColumn.Copy pasteDest
            Set pasteDest = pasteDest.Offset(0, 1) 'move one column over
        End If
    Next c
    
End Sub

相关问题