Question

这是我拥有的原始Excel工作表。

我需要匹配这两列并获得如下输出。

即，如果任意两行之间都存在匹配项，则创建一个新行，否则在不匹配的地方创建空白单元格。

实际上可以在MS-excel中进行吗？我真的希望有可能，因为该工作表包含约900行，并且我不希望手动进行。

帮我解决这个问题。

= IF（ISERROR（MATCH（A2，$ C $ 2：$ C $ 35,0）），“”，A2）

我正在使用以上公式。它确实可以使列表1与列表2匹配，但反之则不行。如何使用它结合两种方式？

Answer 1

根据您提供的有限示例，您的模式如下所示：

如果没有匹配项，则处理Col B值
处理所有匹配的Col A和Col B值，直到没有匹配为止
处理所有不匹配的Col A值，直到Col A和Col B值匹配

由于这听起来像是一个单独的项目，所以我提供了一些VBA来完成此任务，但这并不漂亮。下面是一些屏幕截图，可以指导您完成操作。

要访问VBA编辑器，请按Alt + F11
右键单击左窗格中的一个对象，然后选择“插入/模块”
将创建一个模块，并且右侧将出现一个空白窗格。

将以下vba代码复制并粘贴到“常规”下右侧的空白窗格中

 Public Sub SortAndDisplayData()
 Const sColA As String = "A"
 Const sColB As String = "B"
 Const sColC As String = "C"
 Const sColD As String = "D"
 Dim oColADict As Object, oColBDict As Object
 Dim lRow As Long, lBegRow As Long, lEndRow As Long, lIndex As Long
 Dim vData As Variant, vKey As Variant, vColAKeys As Variant
 Dim vColAKey As Variant, vColBKeys As Variant, vColBKey As Variant

     Set oColADict = CreateObject("Scripting.Dictionary")
     oColADict.CompareMode = vbTextCompare
     Set oColBDict = CreateObject("Scripting.Dictionary")
     oColBDict.CompareMode = vbTextCompare

     With ActiveSheet
         ' Get last row, max of Col A / Col B.
         lEndRow = Application.WorksheetFunction.Max( _
         .Cells(Application.Rows.Count, sColA).End(xlUp).Row, _
         .Cells(Application.Rows.Count, sColB).End(xlUp).Row)

         ' Column A.
         lEndRow = .Cells(Application.Rows.Count, sColA).End(xlUp).Row
         vData = .Range(.Cells(2, sColA), .Cells(lEndRow, sColA)).Value
         vData = Application.WorksheetFunction.Transpose(vData)
         For lIndex = LBound(vData) To UBound(vData)
             Call oColADict.Add(vData(lIndex), Nothing)
         Next

         ' Column B.
         lEndRow = .Cells(Application.Rows.Count, sColB).End(xlUp).Row
         vData = .Range(.Cells(2, sColB), .Cells(lEndRow, sColB)).Value
         vData = Application.WorksheetFunction.Transpose(vData)
         For lIndex = LBound(vData) To UBound(vData)
             Call oColBDict.Add(vData(lIndex), Nothing)
         Next

         ' Recreate in Col C and Col D.
         lRow = 1
         Call .Columns(sColC & ":" & sColD).Delete(shift:=xlToLeft)
         .Cells(lRow, sColC).Value = "List 1"
         .Cells(lRow, sColD).Value = "List 2"
         vColAKeys = oColADict.keys
         vColBKeys = oColBDict.keys
         For Each vColBKey In vColBKeys
             lRow = lRow + 1
             If oColADict.exists(vColBKey) And oColBDict.exists(vColBKey) Then
                 .Cells(lRow, sColC).Value = vColBKey
                 .Cells(lRow, sColD).Value = vColBKey

                 lIndex = GetNextIndex(vColAKeys, vColBKey)
                 vKey = vColAKeys(lIndex)
                 Do While oColADict.exists(vKey) And oColBDict.exists(vKey)
                     lRow = lRow + 1
                     .Cells(lRow, sColC).Value = vKey
                     .Cells(lRow, sColD).Value = vKey

                     Call oColBDict.Remove(vKey)
                     lIndex = lIndex + 1
                     vKey = vColAKeys(lIndex)
                 Loop
             ElseIf oColBDict.exists(vColBKey) Then
                 .Cells(lRow, sColD).Value = vColBKey
             ElseIf oColADict.exists(vKey) Then
                 .Cells(lRow, sColC).Value = vKey
                 If lIndex < UBound(vColAKeys) Then
                     lIndex = lIndex + 1
                     vKey = vColAKeys(lIndex)
                 End If
                 Do While ((oColADict.exists(vKey)) And (Not oColBDict.exists(vKey)) And (lIndex < UBound(vColAKeys)))
                     lRow = lRow + 1
                     .Cells(lRow, sColC).Value = vKey
                     lIndex = lIndex + 1
                     vKey = vColAKeys(lIndex)
                 Loop
             End If
         Next

         Do While oColADict.exists(vKey)
             lRow = lRow + 1
             .Cells(lRow, sColC).Value = vKey
             If lIndex < UBound(vColAKeys) Then
                 lIndex = lIndex + 1
                 vKey = vColAKeys(lIndex)
             Else
                 Exit Do
             End If
         Loop

         .Cells.EntireColumn.AutoFit
     End With

     Call MsgBox("Finished")
     Set oColADict = Nothing: Set oColBDict = Nothing
 End Sub

 Private Function GetNextIndex(vKeys As Variant, vKey As Variant) As Long
 Dim lIndex As Long
     For lIndex = LBound(vKeys) To UBound(vKeys)
         If vKeys(lIndex) = vKey Then
             lIndex = lIndex + 1
             Exit For
         End If
     Next

     GetNextIndex = lIndex
 End Function

单击SortAndDisplayData子项
在菜单中单击“运行”
单击“文件并关闭”以返回到Excel

数据是在Col C和Col D中创建的，因此，如果数据不太正确，您可以进行比较和调整。很抱歉，因为您不了解VBA。

匹配两组列，如果不匹配则创建带有空白行的第三列

1 个答案: