我非常希望VBA执行以下操作
1）剪切选定的行
2）按字母顺序（基于col C）将行插入正确的位置
我无法使用sort的原因是因为我对一张表有大量的引用，当我使用sort时，它搞砸了所有引用，即使它们都有$。我发现切割可以解决这个问题
答案 0 :(得分：1)
我相信下面的宏符合您的要求。
常量ColSort定义我已设置为C的排序列。常量RowDataFirst定义第一个数据行。我的测试数据有两个标题行。根据需要更改RowDataFirst的值。
我只排序了一个测试工作表，但我相信宏可以适用于任意数量的行和列。
我从工作表“SortSrc”到“SortDest”排序。这些工作表的名称由常量WkShtNameDest和WkShtNameSrc定义。根据需要更改这些常量。
我已经包含了shell排序的VBA实现。这不被认为是最好的排序，但我有常规手，你不会排序足够的数据来解决它。
它创建一个包含C列值和行号的数组。我排序这个索引数组。我使用排序索引数组来控制从源工作表到目标的数据复制。
我希望我收到足够的评论。如有必要，请回答问题。
Option Explicit
Sub SortByCutNPaste()
Const ColSort As String = "C"
Const RowDataFirst As Long = 3
Const WkShtNameDest As String = "SortDest"
Const WkShtNameSrc As String = "SortSrc"
Dim ColMax As Long
Dim InxSort As Long
Dim SortArray() As String
Dim RangeDest As Range
Dim RangeSrc As Range
Dim RowDestCrnt As Long
Dim RowMax As Long
Dim RowSrcCrnt As Long
With Sheets(WkShtNameSrc)
' Find the maximum used row and maximum used column
RowMax = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
ColMax = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
End With
' Size sort array so one entry per data row
ReDim SortArray(1 To RowMax - RowDataFirst + 1)
' Build sort array with each entry containing:
' Value of column C Nul Row number padded to three digits
' The Nul is used as a low value in case any cell value ends in what looks
' like a row number. For example:
' Row 1 Value ABC001
' Row 2 Value ABC
' would give sort keys ABC001001 and ABC002 which would be sorted incorrectly.
' Keys ABC001(0)001 and ABC(0)002 will sort incorrectly.
' Use LCase(.Cells(RowSrcCrnt, ColSort).Value) if you want a case insensitive sort.
' I have padded row numbers to three digits since you say you have 100 rows.
InxSort = LBound(SortArray)
With Sheets(WkShtNameSrc)
For RowSrcCrnt = RowDataFirst To RowMax
SortArray(InxSort) = .Cells(RowSrcCrnt, ColSort).Value & _
Chr(0) & Right("000" & RowSrcCrnt, 3)
InxSort = InxSort + 1
Next
End With
' Sort array
Call ShellSort(SortArray, UBound(SortArray))
' Prepare destination worksheet
With Sheets(WkShtNameDest)
' Clear any existing contents
.Cells.EntireRow.Delete
End With
' Copy column widths
With Sheets(WkShtNameSrc)
.Rows(1).EntireRow.Copy
End With
With Sheets(WkShtNameDest)
.Rows(1).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
' For InxSort = LBound(SortArray) To UBound(SortArray)
' Debug.Print SortArray(InxSort)
' Next
' Copy heading rows from source to destination
' Note source and destination row numbers are the same
' so use RowSrcCrnt for both worksheets.
For RowSrcCrnt = 1 To RowDataFirst - 1
With Sheets(WkShtNameSrc)
Set RangeSrc = .Range(.Cells(RowSrcCrnt, 1), .Cells(RowSrcCrnt, ColMax))
End With
With Sheets(WkShtNameDest)
Set RangeDest = .Range(.Cells(RowSrcCrnt, 1), .Cells(RowSrcCrnt, ColMax))
End With
RangeSrc.Copy Destination:=RangeDest
Next
' Copy data rows in index sequence
RowDestCrnt = RowDataFirst
For InxSort = LBound(SortArray) To UBound(SortArray)
RowSrcCrnt = Val(Right(SortArray(InxSort), 3))
With Sheets(WkShtNameSrc)
Set RangeSrc = .Range(.Cells(RowSrcCrnt, 1), .Cells(RowSrcCrnt, ColMax))
End With
With Sheets(WkShtNameDest)
Set RangeDest = .Range(.Cells(RowDestCrnt, 1), .Cells(RowDestCrnt, ColMax))
End With
RangeSrc.Copy Destination:=RangeDest
RowDestCrnt = RowDestCrnt + 1
Next
End Sub
Public Sub ShellSort(ByRef arrstgTgt() As String, ByVal inxLastToSort As Integer)
' Converted by Tony Dallimore in 2005 from Pascal routine in "Algorithms"
' by Robert Sedgewick (2nd edition) published 1989 by Addison-Wesley.
' The most basic sort is the insertion sort in which adjacent elements are compared
' and swapped as necessary. This can be very slow if the smallest elements are at
' end. ShellSort is a simple extension which gains speed by allowing exchange of
' elements that are far apart.
' The idea is to rearrange the file to give it the property that taking every h-th
' element (starting anywhere) yields a sorted file. Such a file is said to be
' h-sorted. Put another way, an h-sorted file is h independent sorted files,
' interleaved together. By h-sorting for large value of H, we can move elements
' in the array long distances and thus make it easier to h-sort for smaller values of
' h. Using such a procedure for any sequence of values of h which ends in 1 will
' produce a sorted file.
' This program uses the increment sequence: ..., 1093, 364, 121, 40, 13, 4, 1. This
' is known to be a good sequence but cannot be proved to be the best.
' The code looks faulty but it is not. The inner loop compares an
' entry with the previous in the sequence and if necessary moves it back down the
' sequence to its correct position. It does not continue with the rest of the sequence
' giving the impression it only partially sorts a sequence. However, the code is not
' sorting one sequence then the next and so on. It examines the entries in element
' number order. Having compared an entry against the previous in its sequence, it will
' be intH loops before the next entry in the sequence in compared against it.
' arrstgTgt The array to be sorted.
' inxLastToSort Elements lbound(arrstgTgt) to inxLastToSort are to be sorted.
Dim intNumRowsToSort As Integer
Dim intLBoundAdjust As Integer
Dim intH As Integer
Dim inxRowA As Integer
Dim inxRowB As Integer
Dim inxRowC As Integer
Dim stgTemp As String
'Dim intComps As Integer
'Dim intSwaps As Integer
intNumRowsToSort = inxLastToSort - LBound(arrstgTgt) + 1
intLBoundAdjust = LBound(arrstgTgt) - 1
' Set intH to 1, 4, 13, 40, 121, ..., 3n+1, ... until intH > intNumRowsToSort
intH = 1
Do While intH <= intNumRowsToSort
intH = 3 * intH + 1
Loop
Do While True
If intH = 1 Then Exit Do
' The minimum value on entry to this do-loop will be 4 so there is at least
' one repeat of the loop.
intH = intH \ 3
For inxRowA = intH + 1 To intNumRowsToSort
stgTemp = arrstgTgt(inxRowA + intLBoundAdjust)
inxRowB = inxRowA
Do While True
' The value of element inxRowA has been saved. Now move the element intH back
' from row inxRowA into this row if it is smaller than the saved value. Repeat
' this for earlier elements until one is found that is larger than the saved
' value which is placed in the gap.
inxRowC = inxRowB - intH
If arrstgTgt(inxRowC + intLBoundAdjust) <= stgTemp Then Exit Do
arrstgTgt(inxRowB + intLBoundAdjust) = arrstgTgt(inxRowC + intLBoundAdjust)
inxRowB = inxRowC
If inxRowB <= intH Then Exit Do
Loop
arrstgTgt(inxRowB + intLBoundAdjust) = stgTemp
Next
Loop
End Sub