[VBA] Excelで簡易Diff

SIerにお勤めの社畜の皆さんこんにちは。社畜Excel職人のdsp74118です。
ご挨拶はさておき、今日の本題へ。

ExcelでDiffしたい

我々SIerの仕事は、1にExcel、2にExcel。3、4がWordで5にPowerPointであるから、Excelで行う作業を如何に効率化するかが、サボる業績を上げるための至上命題である。
さて、我々SIerは「2つのデータのDiffをExcelで見たい」というシチュエーションによく遭遇する。 Excelのブック同士のDiffを取るのであれば、WinMerge＋xdocdiff プラグインとかを使えばよいのだが、当記事は、同一シート内の2つの列でDiffを取り、それを見やすく整形することをテーマとしている。
例えば下図Figure.1のような状況。

Figure.1 A列とC列を比較したい

A列とC列に似たようなデータが入っているが、微妙に違う。これのDiffを取る（SI業界では"突合"と言う）にあたり、Excel使いとして飼い慣らされた社畜であるならば、同一データを同一行に揃えたくなるだろう。

Figure.2 こういう風に同じデータが同一行に揃うと嬉しいよね

このような整形処理を実現するVBAをこの度書いたので、ここに公開する次第である。

インストール（？）

PERSONAL.XLSBの標準モジュールに下記ソースを貼り付けるだけ。

使い方

• 比較したい2つのデータを、ExcelシートのA列とC列に貼り付ける。（B列を空けたのは、作業スペースとして使えるように。） 
• Alt+F8から"PERSONAL.XLSB!ExcelDiff"を呼び出す。

動作条件など

• 比較前のデータには空行がないほうがいいと思う。空行があるとバグる可能性あり。 
• 比較前のデータは予めソートされている方がよいと思う。A列とC列とでデータの並び順が違うと、期待するような結果が得られないと思う。（これは他のdiffツールでも同じ）

ソース

糞コードなので、自由にリファクタリングしたり改造して使ってください。こんなもんに著作権も何もないので。

' Excel de Diff VBA Ver.1.00
' 2013.12.13 dsp74118

Option Explicit

' description:
' 選択中のシートの A 列と C 列を比較し、
' 同じデータが同一行に並ぶように整形する。
Sub ExcelDiff()
    Dim i As Long, j As Long
    Dim lastRow As Long
    lastRow = Rows.Count
    i = 1
    Do While i <= Cells(lastRow, 1).End(xlUp).Row
        If Cells(i, 1).Value <> "" Then
            ' A列と同じデータがC列のどこにあるか探す
            j = c(i, 1, 3)
            If j = 0 Then
                ' A列にあってC列にない場合、C列を下にシフトする
                Cells(i, 3).Insert Shift:=xlDown
            ElseIf j > i Then
                ' C列のほうが下にある場合、A列を同じ行になるよう下にシフト
                Range(Cells(i, 1), Cells(j - 1, 1)).Insert Shift:=xlDown
            ElseIf j < i Then
                ' A列のほうが下にある場合、C列を同じ行になるよう下にシフト
                Range(Cells(j, 3), Cells(i - 1, 3)).Insert Shift:=xlDown
            End If
        End If
        i = i + 1
    Loop
    ' 空行削除
    For i = Cells(lastRow, 1).End(xlUp).Row To 1 Step -1
        If Application.CountA(Rows(i)) = 0 Then
            Rows(i).Delete
        End If
    Next i
End Sub

' Findによる存在チェック
' セル範囲から検索値が見つかったらその行番号を,見つからなかったら0を返す
' 検索値が空だった場合も0を返す
' 検索値：lookupRow行、lookupCol列 のセルの値
' 範囲：targetCol列
Private Function c(lookupRow As Long, lookupCol As Long, targetCol As Long) As Long
    Dim vlk As Object
    c = 0
    If Cells(lookupRow, lookupCol).Value = "" Then
        Exit Function
    End If
    On Error Resume Next
    Set vlk = Columns(targetCol).Cells.Find(Cells(lookupRow, lookupCol).Value, Lookat:=xlWhole)
    If Not vlk Is Nothing Then
        c = vlk.Row
    End If
    On Error GoTo 0
End Function