查找具有唯一值的列移至第一列並對工作表進行排序

Question

我有2個工作表，它們的標題相同，但順序不同。 標頭是ID，名稱，部門，銷售，開始日期，結束日期和其他一些。

我的目的是搜索工作簿中標題可能處於不同順序的工作簿，找到具有唯一值（在本例中為ID）的列，然后將該列移至工作表中的A列，並對其余部分進行排序兩個工作表中的標題/數據，因此布局是相同的。 我的目標是在VBA中做到這一點。

當前，我手動對工作表進行排序，並將相關列復制到工作表的第一列中，並檢查單元格是否匹配。

For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
    If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
        mycell.Interior.Color = vbYellow
        difference = difference + 1
    End If

    If mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
        matches = matches + 1
    End If
Next

Answer 1

查找並移動“ ID”列，如第1列

Sub movecolumn()
Dim sht As Worksheet
Dim keySrc As String
Dim lastcol As Long, cutCol As Long
Dim arrcol As Variant
Set sht = ThisWorkbook.Worksheets("Sheet1")
keySrc = "ID"
lastcol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column 'find the last Headers columns
arrcol = Range(Cells(1, 1), Cells(1, lastcol)) 'Add Headers items to array

If Not IsError(Application.Match(keySrc, arrcol, False)) Then ' Check i the keysrc are into array
    cutCol = Application.Match(keySrc, arrcol, False) 'find the "ID" positiono into array
    If cutCol > 1 Then 'If "ID" column Is not already the first
        Columns(cutCol).Select  ' select "ID" column
        Selection.Cut
        Columns("A:A").Select
        Selection.Insert Shift:=xlToRight
    End If
Else
    MsgBox "the column " & keySrc & " not exist", vbInformation
End If
Range("A2").CurrentRegion.Sort key1:=Range("a2"), order1:=xlAscending, Header:=xlGuess
End Sub