列sorting不对参考列进行sorting，仅在活动列上sorting
我正在尝试将一些代码复制并粘贴到另一个表单上，然后按字母顺序对其进行分类。 问题是当我隐藏工作表 – 即使我取消隐藏并重新隐藏它运行macros – 它似乎只sorting在活动列。
我在下面的第二个macros中以粗体突出显示了sorting代码。 GetNamesListmacros在其代码的末尾调用ConsolidateList。
GetNamesList设置为在打开的工作簿上运行：
Private Sub Workbook_Open() GetNamesList End Sub GetNamesList的原始代码来自： http : //bit.ly/1y3dU6n by @ 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”）。Sort Key1：= Range（“A1”），Order1：= xlAscending
End Sub
谢谢你的帮助…
**更新 – macros的logging做同样的事情…
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
谢谢@SO。 通过采取你的build议和困惑的logging代码，我可以拼凑在一起以下内容：
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)
那固定它…