在有连字符的地方对字母数字数据进行排序

Question

我在工作簿中有两张纸，每张纸上都有自己的电子邮件地址列以及其他数据。我将在Sheet1中引用Column1，在Sheet2中引用Column2，其中只有Column1可能列出了重复的电子邮件地址。

我需要确定是否在Column2中找到了Column1中的电子邮件地址，并且每当为true时，都必须运行某些代码。

我用两个嵌套的Do While循环解决了这个问题，其中外部循环从上到下遍历了Column1中名为Cell1的每个单元，内部循环将Cell1与Column2中每个名为Cell2的单元也从上到下进行了比较，如果找到相同的值，则尽早退出内部循环。

为了提高效率，我想按升序对每一列进行排序，并让每个Cell1仅浏览Column2，直到Cell2中的字符串的值大于Cell1中的字符串的值，并迭代下一个Cell1为止。由于先前的Cell2值均小于Cell1并且不能具有相等的值，因此它将从最后循环停止的Cell2继续。

我想出的代码是一个遍历Column1中每个单元格的外部循环，以及一个如下所示的内部循环：

'x1 is the row number of Cell1
'x2 is the row number of Cell2
'below is the code for the internal loop looking through Column2

Do While Sheets(2).Cells(x2, 1).Value <> 0
    If LCase(Sheets(1).Cells(x1, 1).Value) < LCase(Sheets(2).Cells(x2, 1).Value) Then
        Exit Do
    ElseIf LCase(Sheets(1).Cells(x1, 1).Value) = LCase(Sheets(2).Cells(x2, 1).Value) Then

        '... code is run

        Exit Do
    End If
    x2 = x2 + 1
Loop

问题是电子邮件地址可以带有连字符（-）和撇号（'）。尽管Excel在对列进行排序时会忽略它们，但VBA在比较字母数字值时不会忽略它们。

如果我有：

     A           B
1  Noemi      Noemi
2  no-reply   no-reply
3  notify     notify

该代码将比较A1与B1并查看A1=B1，然后将A2与B1并查看，A2<B1然后跳至A3。

我的第一个问题是，我是否可以强制Excel对包括连字符和撇号在内的字母数字文本进行排序？

如果没有，到目前为止，我只想到了一种变通方法，即查看Cell1和Cell2是否包含-或'，如果它们中的任何一个为TRUE，则使用新变量从Cell1和Cell2中提取文本而无需使用连字符和撇号，并继续在内部循环中使用这些新值。

我的第二个问题是，如何才能更有效地解决此问题？

编辑：

Microsoft认识到Excel在排序时会忽略破折号和撇号：

http://office.microsoft.com/zh-CN/excel-help/default-sort-orders-HP005199669.aspx http://support.microsoft.com/kb/322067

Answer 1

如果昨天有人问我，我会同意 David 对 Excel 排序的预期结果的看法。然而，经过实验，我不得不同意德克的观点。值得注意的是：

撇号 (') 和连字符 (-) 会被忽略，但有一个例外：如果两个文本字符串除了连字符之外都相同，则带有连字符的文本将排在最后。 来源

A 列包含我用于测试 Dirk 声明的未排序值。

B 列已进行常规 Excel 排序。正如您所看到的，该列不是 ASCII/Unicode 序列，因为“单引号”应该出现在“连字符”之前，而“连字符”应该出现在“字母 a”之前。

Excel 使用波形符 (~) 作为“查找”的转义字符，因此我想知道它是否也会对“排序”执行相同的操作。 AdjustedSort1将“单引号”替换为“波形符单引号”，将“连字符”替换为“波形符连字符”，排序然后恢复“单引号”和“连字符”。结果显示在 C 列中。该序列更好，但不是 ASCII/Unicode，因为“aa-b”位于“aa'c”之前。

D 列使用我几年前编写的 VBA 希尔排序例程。如果您的列表非常大，您可能最好在网上搜索“VBA 快速排序”，但我的排序应该为合理大小的列表提供可接受的性能。

Sub AdjustedSort1()

  With Worksheets("Sheet2").Columns("C")

    .Replace What:="'", Replacement:="~'", LookAt:=xlPart, _
             SearchOrder:=xlByRows, MatchCase:=False, _
             SearchFormat:=False, ReplaceFormat:=False
    .Replace What:="-", Replacement:="~-", LookAt:=xlPart, _
             SearchOrder:=xlByRows, MatchCase:=False, _
             SearchFormat:=False, ReplaceFormat:=False
    .Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    .Replace What:="~~-", Replacement:="-", LookAt:=xlPart, _
          SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
    .Replace What:="~~'", Replacement:="'", LookAt:=xlPart, _
          SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False

  End With

End Sub
Sub AdjustedSort2()

  Dim Inx As Long
  Dim RngValue As Variant
  Dim RowLast As Long
  Dim ColValue() As String

  With Worksheets("Sheet2")

    RowLast = .Cells(Rows.Count, "D").End(xlUp).Row

    ' Load values from column D excluding header
    RngValue = .Range(.Cells(2, "D"), .Cells(RowLast, "D")).Value

    ' Copy values from 2D array to 1D array
    ReDim ColValue(LBound(RngValue, 1) To UBound(RngValue, 1))
    For Inx = LBound(RngValue, 1) To UBound(RngValue, 1)
      ColValue(Inx) = RngValue(Inx, 1)
    Next

    ' Sort array
    Call ShellSort(ColValue, UBound(ColValue))

    ' Copy values back to 2D array
    For Inx = LBound(ColValue) To UBound(ColValue)
      RngValue(Inx, 1) = ColValue(Inx)
    Next

    ' Copy values back to column D
    .Range(.Cells(2, "D"), .Cells(RowLast, "D")).Value = RngValue

  End With

End Sub
Public Sub ShellSort(arrstgTgt() As String, inxLastToSort As Integer)

  ' Coded 2 March 07
  ' Algorithm and text from Algorithms (Second edition) by Robert Sedgewick

  '   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.

  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

  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