Moving Columns based on header name

前端 未结 2 1679
一整个雨季
一整个雨季 2020-12-20 03:19

I have a macro that rearranges the columns into a particular order.

Sub ArrangeColumns()

\' ArrangeColumns Macro

    Columns(\"C:C\").Select
    Applicatio         


        
相关标签:
2条回答
  • 2020-12-20 04:05

    Alternative using Application.Index in a one liner

    For the sake of the art and just to demonstrate a working alternative using the advanced restructuring possibilities of the Application.Index function (c.f. section [2]):

    
    Sub colOrder()
    ' Purpose: restructure range columns
      With Sheet1                                               ' worksheet referenced e.g. via CodeName
    
        ' [0] identify range
          Dim rng As Range, lastRow&, lastCol&
          lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row        ' get last row and last column
          lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
          Set rng = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
    
        ' ~~~~~~~~~~~~
        ' [1] get data
        ' ~~~~~~~~~~~~
          Dim v: v = rng                                        ' assign to 1-based 2-dim datafield array
    
        ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ' [2] restructure column order in array in a one liner
        ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          v = Application.Index(v, Evaluate("row(1:" & lastRow & ")"), getColNums(v))
    
        ' [3] write data back to sheet
          rng = vbNullString                                    ' clear orginal data
          .Range("A1").Resize(UBound(v), UBound(v, 2)) = v      ' write new data
    
      End With
    
    End Sub
    

    Helper function called by above main procedure

    The helper function simply returns an array with the correct column numbers found in the current titles; it uses Application.Match to find occurrencies:

    Function getColNums(arr) As Variant()
    ' Purpose: return array of found column number order, e.g. Array(3,2,1,4,6,5)
    Dim colOrdr(), titles                                           ' wanted order, current titles
    colOrdr = Array("id", "last_name", "first_name", "gender", "email", "ip_address") 'define column order with header names here
    titles = Application.Transpose(Application.Transpose(Application.Index(arr, 1, 0)))
    
    Dim i&, ii&, pos                                                ' array counters, element position
    ReDim tmp(0 To UBound(colOrdr))                                 ' temporary array to collect found positions
    For i = 0 To UBound(colOrdr)                                    ' loop through titles in wanted order
        pos = Application.Match(colOrdr(i), titles, 0)              ' check positions
        If Not IsError(pos) Then tmp(ii) = pos: ii = ii + 1         ' remember found positions, increment counter
    Next i
    ReDim Preserve tmp(0 To ii - 1)                                 ' remove empty elements
    getColNums = tmp                                                ' return array with current column numbers (1-based)
    End Function
    
    

    Related link

    I listed some pecularities of the Application.Index function at Insert first column in datafield array without loops or API calls

    0 讨论(0)
  • 2020-12-20 04:15

    If you know all the header names, you can define an array of the header names and use the array's index to move the columns around.

    Sub columnOrder()
    Dim search As Range
    Dim cnt As Integer
    Dim colOrdr As Variant
    Dim indx As Integer
    
    colOrdr = Array("id", "last_name", "first_name", "gender", "email", "ip_address") 'define column order with header names here
    
    cnt = 1
    
    
    For indx = LBound(colOrdr) To UBound(colOrdr)
        Set search = Rows("1:1").Find(colOrdr(indx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        If Not search Is Nothing Then
            If search.Column <> cnt Then
                search.EntireColumn.Cut
                Columns(cnt).Insert Shift:=xlToRight
                Application.CutCopyMode = False
            End If
        cnt = cnt + 1
        End If
    Next indx
    End Sub
    

    Any column not named in the array will appear on the right of the ones named.

    0 讨论(0)
提交回复
热议问题