如何根据一列对多个命名范围进行排序？

Question

我需要在一个已经由Data1，Data2，......命名的Excel工作表中对多个命名范围进行排序。

在每个命名范围内，都有一个用于排序的单元格。我的问题是我希望命名范围内的所有数据都相应地移动到已排序的单元格。

根据图片，如果列A已排序，则右侧的数据也会向上移动。

Answer 1

假设您想要排序的是多行中的重复字符串，例如A列，则行24-50都包含＆＃34; file1＆＃34;然后，您可以使用以下代码选择在指定列中包含该字符串的所有行。从那里你可以应用你的排序。

    Private Sub Test1()

    Dim c As Range
    Dim d As Range
    Dim Fitem As String 
    Dim FEndRange As Long
    Dim FStartRange As Long

'Search for the name of the header you want to base your range off of...

    With Worksheets("Sheet1").Range("A1").EntireRow
    Set c = .Find("HEADER", LookIn:=xlValues)
    End With

    With Worksheets("Sheet1").Range(c.Address).EntireColumn
    Set d = .Find("file1", LookIn:=xlValues)
    Set c = Worksheets("Sheet1").Cells(d.Row, c.Column)
    Fitem = c.Value
    End With

    If (c.EntireColumn.Find(what:=Fitem, lookat:=xlWhole, After:=Cells(2, c.Column)).Row)  0 Then
    FStartRange = c.EntireColumn.Find(what:=Fitem, After:=Cells(1, c.Column)).Row
    FEndRange = c.EntireColumn.Find(what:=Fitem, After:=Cells(1, c.Column), searchdirection:=xlPrevious).Row

    Worksheets("Sheet1").Cells(FStartRange, d.Column).Activate
    Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(FStartRange, d.Column), Worksheets("Sheet1").Cells(FEndRange, d.Column)).EntireRow.Select

        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=c, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Sheet1").Sort

'place your sort criteria here

    End With
    End If

    End Sub

Answer 2

根据您的图片和评论中的新信息，以下代码可以帮助您获得所需的信息。

    Option Explicit
    Private Sub Test()

    Dim x As Long
    Dim y As Long
    Dim s As Long
    Dim t As Long
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastrow As Long

    lastrow = ActiveWorkbook.Worksheets("Sheet1").Cells(ActiveWorkbook.Worksheets("Sheet1").Rows.Count, "E").End(xlUp).Row
    Set ws = Worksheets("Sheet1")

    ws.Activate
    y = WorksheetFunction.CountIf(Range("A:A"), "Data*")
    s = 1

    For x = 1 To y
    s = ws.Range("A:A").Find(what:="Data*", after:=Range("A" & s)).Row

    If x = y Then
    t = lastrow + 2
    Else
    t = ws.Range("A:A").Find(what:="Data*", after:=Range("A" & s)).Row
    End If

    ws.Range(ws.Cells(s, 5), ws.Cells(t - 2, 17)).Select

'Add sort criteria here

    Next x

    End Sub

我使用的字母是任意的，可以更改为任何字母。