Question

是否有一种简单的方法可以按照

的方式对两个相邻列进行排序

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

E.g。那些专栏

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

应该转化为：

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

Answer 1

如果没有vba，您需要在几个步骤中完成，结果将在不同的列中。

复制并通过一列中的两列。
转到数据---＆gt;删除重复项。
对该列进行排序。

使用此列作为订单的参考。将以下公式放在第一个单元格中：=IFERROR(INDEX(A:A,MATCH($C1,A:A,0)),"")然后上下复制。

Answer 2

我有一些空余时间，感受到了挑战。所以，我编写了以下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

以上sub假设两列位于Worksheet(1)和A列的第一张B上。结果将在第二张Worksheet(2)上提供（也在A和B列中提供。

背后的基本概念是：

阅读列A中的项目，并将其写入数组strArray的第一维。
将strArray的第二个维度设置为1.这是一个帮助“位”，以便记住此项位于列A中。
阅读列B中的项目。如果已在当前strArray集中找到该项，则还将第三个维设置为1（以便记住此列也在列B中找到）。如果该项目尚未在strArray中，则添加该项目并仅将第三个维度设置为1。
对数组strArray进行排序。
将数组写回第二张，同时检查第二和第三维，如果之前在列A和/或列B中找到此项目。

更新

考虑上述解决方案让我意识到这个解决方案不是最理想的，因为最终的数组strArray不能直接写入工作表（或范围），而只是作为“指南”来做到这一点。如果strArray可以直接写回工作表，它会更快更优雅。因此，我稍微更改了上面的代码：所有数组现在都是1，以适应基于1的工作表范围（从第1列和第1行开始）。此外，strArray的第二维不再是“位”，而是（直接）第二列到结果范围。因此，阵列可以直接写回到工作表（在一个范围内）。然而，最后一次更改使我调整了排序算法，因为最终数组中现在有空项。

因此，改进的代码（基于上述评论）现在是：

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

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

2 个答案:

更新