将excel中的两列与排在同一行的匹配进行sorting

有没有一种简单的方法来sorting两个相邻的列的方式

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

例如那些专栏

ab fa ee ml ki ih 

应该转化为这个：

 aa b ee fh ii kl m 

Answer 1

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

1. 复制一列中的两列。

2. 转到数据—>删除重复。

3. sorting该列。

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

Answer 2

我有一些闲暇时间，并感受到了挑战。 所以，我写了下面的VBA子，它做你想做的事情：

 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假设两列在A和B列的第一张Worksheet(1)上。 结果将在第二张Worksheet(2) （也在列A和B ）中提供。

背后的基本概念是：

1. 读取列A的项目并将它们写入数组strArray的第一维。
2. 设置strArray的第二个维度为1.这是一个帮助器“位”，以记住这个项目在列A 。
3. 阅读B栏中的项目。 如果在当前的strArray集合中已经find该项目，那么还要将第三维设置为1（以记住在B列中也可以find该项目）。 如果该项目还没有在strArray然后添加它，并只设置第三维为1。
4. 对数组strArraysorting。
5. 将数组写回到第二个工作表，同时检查第二个和第三个维度，如果此项目以前在A列和/或B列中find。

更新：

考虑到上面的解决scheme，我意识到这个解决scheme是不理想的，因为最终的数组strArray不能直接写到表单（或范围），而仅仅是作为一个“准则”来做到这一点。 如果strArray可以直接写回到工作表，它会更快更优雅。 因此，我改变了上面的代码：现在所有的数组都是基于1的，以适应基于1的工作表范围（从第1列和第1行开始）。 此外， strArray的第二维不再是“位”，而是（直接）第二列到结果范围。 因此，数组可以直接写回到表单（进入范围）。 然而，这最后的变化使我调整了sortingalgorithm，因为最终数组中现在有空项目。

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

 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