Question

我正在尝试调整一些代码，这些代码将两个单独的范围复制并粘贴到另一个不同的工作表上，然后按字母顺序对其进行排序。问题是当我隐藏工作表时 - 即使我取消隐藏并重新隐藏它以运行宏 - 它似乎只在活动列上排序。

我在下面的第二个宏中用粗体单挑出了排序代码。 GetNamesList宏在其代码末尾调用ConsolidateList。

GetNamesList设置为在工作簿打开时运行：

Private Sub Workbook_Open()
GetNamesList
End Sub

GetNamesList的原始代码来自：http://bit.ly/1y3dU6n @ Siddharth-rout

Sub GetNamesList()
Dim rng As Range, aCell As Range
Dim MyAr() As Variant
Dim n As Long, i As Long

Application.ScreenUpdating = False
Sheet28.Visible = True

'~~> Change this to the relevant sheet
With Sheet3
    '~~> Non Contiguous range
    Set rng = .Range("Table2[Contact 1],Table2[Contact 2]")

    '~~> Get the count of cells in that range
    n = rng.Cells.Count

    '~~> Resize the array to hold the data
    ReDim MyAr(1 To n)

    n = 1

    '~~> Store the values from that range into
    '~~> the array
    For Each aCell In rng.Cells
        MyAr(n) = aCell.Value
        n = n + 1
    Next aCell
End With

'~~> Output the data in Sheet

'~~> Vertically Output to sheet 28
Sheet28.Cells(1, 1).Resize(UBound(MyAr), 1).Value = _
Application.WorksheetFunction.Transpose(MyAr)

ConsolidateList

Sheet28.Visible = False
Application.ScreenUpdating = True
End Sub

ConsolidateList是：

Sub ConsolidateList()
'
' ConsolidateList Macro
' Remove duplicates and blanks
'

  With Sheet28.Range("A1:A1000")
    .Value = .Value
    .RemoveDuplicates Columns:=1, Header:=xlNo
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
    On Error GoTo 0
End With

列（“A：A”）。排序Key1：=范围（“A1”），订单1：= xlAscending

End Sub

感谢您的帮助......

**更新 - 录制宏来做同样的事情......

Sub TestSort()
'
' TestSort Macro
'
Sheets("Jan").Select
Sheets("Sheet1").Visible = True
ActiveWindow.SmallScroll Down:=-405
Range("A1:A134").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:A134")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
ActiveWindow.SmallScroll Down:=-245
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub

Answer 1

谢谢@ S-O。通过采纳你的建议和对记录的代码感到困惑，我能够拼凑出以下内容：

Sub ConsolidateList()
'
' ConsolidateList Macro
' Remove duplicates and blanks
'

  With Sheet28.Range("A1:A1000")
    .Value = .Value
    .RemoveDuplicates Columns:=1, Header:=xlNo
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
    On Error GoTo 0
End With

Sheet28.Sort.SortFields.Clear
Sheet28.Sort.SortFields.Add Key:=Range("A1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:A134")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

End Sub

虽然ActiveWorkbook似乎在那里偷偷摸摸......！

**更新

代替

With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:A134")

使用：

顶部

Dim Lastrow As Integer

然后

Lastrow = Sheet28.Cells.Find("*", searchorder:=xlByRows,searchdirection:=xlPrevious).Row
    With Sheet28.Sort
    .SetRange Range("A1:A" & Lastrow)

修好了......

Column Sort不对引用列进行排序，仅在活动列上排序

1 个答案: