二つの列の差分をそろえて見やすくする

二つのそれぞれの列で等しいもの、ひとしくないものを、整列します。

事前にソートされている前提です。

Sub 差分シフト()
    
'ソートされている事が前提
'左右いずれかの行が空白になった時点で終了

    
    Const COL_LEFT_KEY_ST As Long = 1
    Const COL_LEFT_KEY_ED As Long = 2
    
    Const COL_LEFT_DATA_ST As Long = 1
    Const COL_LEFT_DATA_ED As Long = 3
    
    Const COL_RIGHT_KEY_ST As Long = 5
    Const COL_RIGHT_KEY_ED As Long = 6
    
    Const COL_RIGHT_DATA_ST As Long = 5
    Const COL_RIGHT_DATA_ED As Long = 7
    
    Const ROW_START As Long = 2 '比較開始行
    
    
    
    
    
    
    
    Dim ixCurrentRow As Long
    Dim resultStrcmp As Variant
    
    Dim ixCol As Long
    Dim ixValues As Long
    
    Dim keyLeftValues()     As String
    Dim keyRightValues()    As String
    
    
    Dim val1 As Variant
    Dim val2 As Variant
    
    
    ReDim keyLeftValues(COL_LEFT_KEY_ED - COL_LEFT_KEY_ST)
    ReDim keyLeftValues(COL_RIGHT_KEY_ED - COL_RIGHT_KEY_ST)
    
    
    ixCurrentRow = ROW_START
    
    Do
        'KeyValuesのクリア
        ReDim keyLeftValues(COL_LEFT_KEY_ED - COL_LEFT_KEY_ST)
        ReDim keyRightValues(COL_RIGHT_KEY_ED - COL_RIGHT_KEY_ST)
        
        '左側キーの設定
        ixValues = 0
        For ixCol = COL_LEFT_KEY_ST To COL_LEFT_KEY_ED
            keyLeftValues(ixValues) = Trim$(Me.Cells(ixCurrentRow, ixCol))
            ixValues = ixValues + 1
        Next ixCol
        
        '右側キーの設定
        ixValues = 0
        For ixCol = COL_RIGHT_KEY_ST To COL_RIGHT_KEY_ED
            keyRightValues(ixValues) = Trim$(Me.Cells(ixCurrentRow, ixCol))
            ixValues = ixValues + 1
        Next ixCol
        
        
        'キーの片側が、未設定の時は、loopを抜ける
        Dim haveData As Boolean
        
        haveData = False
              
        For ixValues = 0 To UBound(keyLeftValues)
            If keyLeftValues(ixValues) <> "" Then
                haveData = True
            End If
        Next ixValues
        
        If haveData = False Then
            Exit Do
        End If
        
        haveData = False
              
        For ixValues = 0 To UBound(keyRightValues)
            If keyRightValues(ixValues) <> "" Then
                haveData = True
            End If
        Next ixValues
        
        If haveData = False Then
            Exit Do
        End If
        
        
        
        '左右のキーの大小関係を調べる
        Dim compResult As Long
        compResult = 0
        
        For ixValues = 0 To UBound(keyLeftValues)
        
        
            If keyLeftValues(ixValues) = keyRightValues(ixValues) Then
                compResult = 0
            ElseIf keyLeftValues(ixValues) > keyRightValues(ixValues) Then
                compResult = 1
            Else
                compResult = -1
            End If
            
            If compResult <> 0 Then
                Exit For
            End If
            
        Next ixValues
        
        
        '左のキーが大きい（compResult = 1） ときは、左のキーを下げる
        If compResult > 0 Then
          Call Range(Me.Cells(ixCurrentRow, COL_LEFT_DATA_ST), Me.Cells(ixCurrentRow, COL_LEFT_DATA_ED)).Insert(xlDown, xlFormatFromLeftOrAbove)
        End If
        
        '右のキーが大きい（compResult = -1） ときは、右のキーを下げる
        If compResult < 0 Then
          Call Range(Me.Cells(ixCurrentRow, COL_RIGHT_DATA_ST), Me.Cells(ixCurrentRow, COL_RIGHT_DATA_ED)).Insert(xlDown, xlFormatFromLeftOrAbove)
        End If
        


        ixCurrentRow = ixCurrentRow + 1

    Loop
    

End Sub