在excel中对两列进行排序，匹配项在同一行中结束

有没有一种简单的方法来对两个相邻的列进行排序

• 它们按字母顺序排列
• 如果一个项目在两列中都存在，它将在同一行中结束
• 如果一项仅存在于一列中，则另一列中的单元格为空

例如，那些栏目

a   b
f   a
e   e
m   l
k   i
i   h

应转化为：

a   a
    b
e   e
f   
    h
i   i
k   
    l
m   

---

如果没有vba，您需要分两步完成，结果将显示在不同的列中

复制并通过一列中的两列

转到数据--->删除重复项

对该列进行排序

使用此列作为订单的参考。将以下公式放入第一个单元格：

=IFERROR（索引（A:A，匹配（$C1，A:A，0）），“”）

然后反复复制

---

我有一些业余时间，觉得自己能应付挑战。因此，我编写了以下VBA sub，它完成了您希望它完成的任务：

Option Base 0
Option Explicit

Public Sub SortThem()

Dim lngRow As Long
Dim lngItem As Long
Dim bolFound As Boolean
Dim strArray() As String
Dim strTMP(0 To 2) As String
Dim varColumn1 As Variant, varColumn2 As Variant

varColumn1 = ThisWorkbook.Worksheets(1).Range("A:A").SpecialCells(xlCellTypeConstants).Value2
varColumn2 = ThisWorkbook.Worksheets(1).Range("B:B").SpecialCells(xlCellTypeConstants).Value2

ReDim strArray(2, 0)
'Read Column1 into array
For lngRow = LBound(varColumn1) To UBound(varColumn1)
    ReDim Preserve strArray(2, UBound(strArray, 2) + 1)
    strArray(0, UBound(strArray, 2)) = varColumn1(lngRow, 1)
    strArray(1, UBound(strArray, 2)) = 1    'this "bit" should indicate that this item is / was present in Column1
Next lngRow

'Read Column2 into array
For lngRow = LBound(varColumn2) To UBound(varColumn2)
    bolFound = False
    For lngItem = LBound(strArray, 2) To UBound(strArray, 2)
        If strArray(0, lngItem) = varColumn2(lngRow, 1) Then
            bolFound = True
            strArray(2, lngItem) = 1        'note that this item is / was also present in Column2
        End If
    Next lngItem
    If bolFound = False Then
        ReDim Preserve strArray(2, UBound(strArray, 2) + 1)
        strArray(0, UBound(strArray, 2)) = varColumn2(lngRow, 1)
        strArray(2, UBound(strArray, 2)) = 1    'this "bit" should indicate that this item is / was present in Column2
    End If
Next lngRow

'Sort array
For lngRow = LBound(strArray, 2) To UBound(strArray, 2) - 1
    For lngItem = lngRow + 1 To UBound(strArray, 2)
        If strArray(0, lngRow) > strArray(0, lngItem) Then
            strTMP(0) = strArray(0, lngItem)
            strTMP(1) = strArray(1, lngItem)
            strTMP(2) = strArray(2, lngItem)

            strArray(0, lngItem) = strArray(0, lngRow)
            strArray(1, lngItem) = strArray(1, lngRow)
            strArray(2, lngItem) = strArray(2, lngRow)

            strArray(0, lngRow) = strTMP(0)
            strArray(1, lngRow) = strTMP(1)
            strArray(2, lngRow) = strTMP(2)
        End If
    Next lngItem
Next lngRow

'Write array back to sheet
For lngRow = 1 To UBound(strArray, 2)
    ThisWorkbook.Worksheets(2).Cells(lngRow, 1).Value2 = IIf(strArray(1, lngRow) = "1", strArray(0, lngRow), "")
    ThisWorkbook.Worksheets(2).Cells(lngRow, 2).Value2 = IIf(strArray(2, lngRow) = "1", strArray(0, lngRow), "")
Next lngRow

End Sub

上述

子部分

假设两列位于第一张

工作表（1）

的

A和
B列中。结果将在第二张
工作表（2）
（也在
A
和
B
列）中提供

它背后的基本概念是：

从列
A
中读取项目，并将它们写入数组
strArray
的第一个维度
将
strArray
的第二个维度设置为1。这是一种帮助器“位”，用于记住此项位于列
a
中
阅读
B列
中的项目。如果该项目已在当前的
strArray
集合中找到，则还应将第三维设置为1（记住，该项目也在
B列中找到）。如果项目还未处于
strArray
中，则添加该项目并仅将第三维设置为1

对数组进行排序
strArray
将数组写回第二张图纸，同时检查第二和第三维度（如果以前在列
A
和/或列
B
中找到此项）
更新：
考虑到上述解决方案，我意识到这个解决方案并不理想，因为最终的数组
strArray
不能直接写入到工作表（或范围）中，而只能作为这样做的“指南”。如果
strArray
可以直接写回工作表，那么它会更快、更优雅。因此，我稍微修改了上面的代码：所有数组现在都是基于
1
的，以适应基于1的工作表范围（从第1列和第1行开始）。此外，
strArray
的第二维度不再是“位”，而是（直接）结果范围的第二列。因此，数组可以直接写回工作表（到一个范围内）。然而，这最后一次更改使我调整了排序算法，因为现在最终数组中有空项

因此，改进后的代码（基于上述注释）现在是：

您可能需要VBA来完成此任务感谢您的努力，工作起来很有魅力，但我更喜欢Scott Craner提供的非VBA解决方案，
Option Base 1
Option Explicit

Public Sub SortThem()

Dim lngRow As Long
Dim lngItem As Long
Dim bolFound As Boolean
Dim strArray() As String
Dim strTMP(1 To 2) As String
Dim varColumn1 As Variant, varColumn2 As Variant

varColumn1 = ThisWorkbook.Worksheets(1).Range("A:A").SpecialCells(xlCellTypeConstants).Value2
varColumn2 = ThisWorkbook.Worksheets(1).Range("B:B").SpecialCells(xlCellTypeConstants).Value2

ReDim strArray(2, 1)
'Read Column1 into array
For lngRow = LBound(varColumn1) To UBound(varColumn1)
    ReDim Preserve strArray(2, UBound(strArray, 2) + 1)
    strArray(1, UBound(strArray, 2) - 1) = varColumn1(lngRow, 1)
Next lngRow
ReDim Preserve strArray(2, UBound(strArray, 2) - 1)

'Read Column2 into array
For lngRow = LBound(varColumn2) To UBound(varColumn2)
    bolFound = False
    For lngItem = LBound(strArray, 2) To UBound(strArray, 2)
        If strArray(1, lngItem) = varColumn2(lngRow, 1) Then
            bolFound = True
            strArray(2, lngItem) = strArray(1, lngItem)
        End If
    Next lngItem
    If bolFound = False Then
        ReDim Preserve strArray(2, UBound(strArray, 2) + 1)
        strArray(2, UBound(strArray, 2)) = varColumn2(lngRow, 1)
    End If
Next lngRow

'Sort array
For lngRow = LBound(strArray, 2) To UBound(strArray, 2) - 1
    For lngItem = lngRow + 1 To UBound(strArray, 2)
        If IIf(strArray(1, lngRow) = vbNullString, strArray(2, lngRow), strArray(1, lngRow)) > _
            IIf(strArray(1, lngItem) = vbNullString, strArray(2, lngItem), strArray(1, lngItem)) Then
                strTMP(1) = strArray(1, lngItem)
                strTMP(2) = strArray(2, lngItem)

                strArray(1, lngItem) = strArray(1, lngRow)
                strArray(2, lngItem) = strArray(2, lngRow)

                strArray(1, lngRow) = strTMP(1)
                strArray(2, lngRow) = strTMP(2)
        End If
    Next lngItem
Next lngRow

'Write array back to sheet
ThisWorkbook.Worksheets(2).Range("A1").Resize(UBound(strArray, 2), UBound(strArray, 1)) = Application.Transpose(strArray)

End Sub