Vba 根据另一列的值顺序对列进行排序

我在电子表格1中有两列：

Col1  Col2     

1     PDC      
2     SR3      
3     PDC      
4     VBM      
5     VBM
6     GAL
7     VBM
8     GAL
9     PDC

我在电子表格2中有一列：

Col1

PDC
SR3
VBM
GAL

如何根据电子表格2 Col1中的顺序对电子表格1中的Col1和Col2进行排序？

请尝试以下代码：

Sub test()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastrow As Long
    Dim rng As Range

    'if workbook2 is already opened
    Set wb = Workbooks("Book2") ' change Book2 to suit
    'if workbook2 is not opened
    'Set wb = Workbooks.Open("C:\Book2.xlsx")

    'change sheet1 to suit
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    'change sheet2 to suit
    Set ws2 = wb.Worksheets("Sheet2")

    With ws1
        'change column B to column with your values "PDC", "SR3" and so on
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        'change to address of range you wnat to sort
        Set rng = .Range("A1:B" & lastrow)
        With rng.Offset(, rng.Columns.Count).Resize(, 1)
            .EntireColumn.Insert
            .Offset(, -1).FormulaR1C1 = "=MATCH(RC[-1],'[" & wb.Name & "]" & ws2.Name & "'!C1:C1,0)"
            .Offset(, -1).Value = .Offset(, -1).Value
        End With
        With rng.Resize(, rng.Columns.Count + 1)
            .Sort Key1:=.Cells(1, .Columns.Count), Order1:=xlAscending, Header:=xlGuess
            .Cells(1, .Columns.Count).EntireColumn.Delete
        End With
    End With

    wb.Close
End Sub

解释：

有两本作业本。代码应位于第一个工作簿中的位置（您要在其中对范围进行排序）

其主要思想是使用类似于

=MATCH（B1，[Book2]Sheet2！A:A，0）

的公式添加临时列，以从A列（workbook2）的B列（workbook1）中获取值的行号

基于此数字的排序范围

删除临时列

注意事项：

下一行假设带有“PDC”的列、“SR3”（在workbook1中）是所选范围内的最后一列（

Set rng=.range（“A1:B”&lastrow）

）：

如果不正确，则将

RC[-1]

更改为，如果此列是最后一列，则说

RC[-2]

，依此类推

---

C1:C1

公式的一部分意味着在工作簿2中带有“PDC”的列中，“SR3”是列

A

（列№1). 如果不正确，则将其更改为，例如，

C5:C5

，这意味着该列是

E

（列№5） .

我发现这段代码似乎有点简单，而且效果很好

Sub NewSortTest()
    Dim keyRange As Variant
    Dim sortNum As Long

    keyRange = ActiveWorkbook.Worksheets("Sheet2").Cells.Range("A1:A10").Value

    Application.AddCustomList ListArray:=keyRange
    sortNum = Application.CustomListCount

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add key:=Range("A1:A20"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B20")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub NewSortTest()
    Dim keyRange As Variant
    Dim sortNum As Long

    keyRange = ActiveWorkbook.Worksheets("Sheet2").Cells.Range("A1:A10").Value

    Application.AddCustomList ListArray:=keyRange
    sortNum = Application.CustomListCount

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add key:=Range("A1:A20"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortNum, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B20")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub