EXCELに重複行解決の研究

モデル表

	A	B	C
1	住所地	名前	金額
2	東京都	北木伊太郎	300
3	東京都	北キータ	400
4	東京都	南みなみ	250
5	大阪府	喜多キータ	300
6	大阪府	皆美みなみ	650
7	東京都	北キータ	2500
8	大阪府	喜多キータ	300

B列3、7行目、５、8行目が重複しています。
これからデータの重複を整理をする方法を書いていきます。

解決のための準備、最大行のみつもり

何行があるかわからないときは適当に100行と見積もります。
ガチガチに最終行である必要はありません。
もちろんLASTROWとかを使ってもいいのですが、ざっくりとでいいです。
余裕をみて多めに見ている方がよいと思います。

解決のための準備重複チェック列の追加

重複をチェックするための行をまず設定します。
たとえばA列も重複しています。
そうするとA,Bの重複をチェックするには2列追加することになります。
今回はB列のみチェックします。
D2に次のような数式をいれて下にコピーします。
=IF(COUNTIF($B$2:$B$100,B2)>1,"★","")

AddDuplicationcheck.Bas

Sub AddDuplicationcheck()
    Range("D1").Value = "Dup.Chk_B"
    Range("D2").Select
    ActiveCell.Formula = "=IF(COUNTIF($B$2:$B$100,B2)>1,""★"","""")"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D8"), Type:=xlFillDefault
    Range("D2:D8").Select
    Range("D2").Select
    Application.CutCopyMode = False
End Sub

重複個数カウント列の追加

次にB列で北キータはいくつ重複しているか、という重複個数カウント列を作ります。
=COUNTIF($B$2:$B$100,B2)
$B$2:$B$100が絶対番地、B2が現在の行のB列です。

DuplicationCount.BAS

Sub DuplicationCount()
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Dup.Count"
    Range("E1").Select
    ActiveSheet.Paste
    Range("E2").Select
    Application.CutCopyMode = False
    ActiveCell.Formula = "=COUNTIF($B$2:$B$100,B2)"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E8"), Type:=xlFillDefault
End Sub

重複チェック列に★がついているところが、重複している行。そしてその横が2となっていれば、見積もった最大行(100行）のなかで2行重複しています。
この見積もった最大行より、データのある行数は十分に小さいので、2行重複していることがわかります。
しかし3行目の北キータは、重複している北キータの2行のうちの1行目でしょうか、2行目でしょうか。この表は小さいので1行目だとわかります。しかし、これを判別する方法はあるのでしょうか。

重複行の重複順列

これなんていったらいいかわかりませんが、3行目の北キータは3、7行目の北キータのうち1番目です。これが関数でわかる方法があるでしょうか。
=COUNTIF($B$2:B2,B2)/COUNTIF($B$2:$B$100,B2)
それがこれです。これをF2に入れます。
COUNTIF($B$2:B2,B2)　ここでB2,B2と相対番地になっています。つまり重複があった重複があった数だけ増えます。
分母はどうでしょうか。
分母は最大見積もり行の100で固定されています。つまり常に重複行数が返ります。
そうすると最初に現れる重複した行は
分子１、分母２となり0.5となります。
そして横には重複個数がカウントされています。
つまり、3行目の北キータは2行あるうちの1行目だとわかります。

DupOrder.Bas

Sub DupOrder()
    Range("F2").Select
    ActiveCell.Formula = _
        "=COUNTIF($B$2:B2,B2)/COUNTIF($B$2:$B$100,B2)"
    Range("F2").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("F2:F8"), Type:=xlFillDefault
    Range("F2:F8").Select
End Sub

最大行等の判定

B列は文字だけです。金額のあるC列で有効なのが
=LOOKUP(9^9,C:C,ROW(C:C))-1
です
これは7が返ります。
=LOOKUP(9^9,B:B,ROW(B:B)-1
はN/Aでエラーになります
空白がない、という前提だとCountAで文字列のある行でもカウントできます。
=COUNTA(B1:B100) -1
=COUNTA(C1:C100) -1
いずれも7という数字が得られます。

重複を除いた行数

全部で7行のデータのうち、4行が重複しています。
ということは
7-4+(4/2)=5というデータになります。
これは
=SUMPRODUCT(1/COUNTIF(B2:B8,B2:B8))
でこの5行というデータを得ることができます。
ただしこの方法では、B8と、最終行をきちんと把握する必要があります。
しかし前項で最大行はCountAで得られていますので、この8という数字は簡単に得ることができるでしょう。
まとめると以下のマクロのようになります。

OtherFunc.BAS

Sub OtherFunction()
ActiveSheet.UsedRange.Select
Selection.Clear
Dim ArColA: ArColA = Split("住所地 東京都 東京都 東京都 大阪府 大阪府 東京都 大阪府 大阪府 大阪府 大阪府", " ")
Dim ArColB: ArColB = Split("名前 北木伊太郎 北キータ 南みなみ 喜多キータ 喜多キータ 皆美みなみ 北キータ 喜多キータ 喜多キータ 喜多キータ 喜多キータ", " ")
Dim arColC: arColC = Split("金額 300 400 250 300 300 650 2500 300 300 300 300", " ")
Dim irow As Long, icol As Long
Dim ws As Worksheet: Set ws = ActiveSheet
For i = LBound(ArColA) To UBound(ArColA)
ws.Cells(i + 1, 1).Value = ArColA(i)
ws.Cells(i + 1, 2).Value = ArColB(i)
ws.Cells(i + 1, 3).Value = arColC(i)
Next i
Range("D1").Value = "Dup.Chk_B"
Range("D2").Select
ActiveCell.Formula = "=IF(COUNTIF($B$2:$B$100,B2)>1,""★"","""")"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D11"), Type:=xlFillDefault
Range("D2:D8").Select
Range("D2").Select
Application.CutCopyMode = False

Range("E1").Select
ActiveCell.FormulaR1C1 = "Dup.Count"
Range("E2").Select
Application.CutCopyMode = False
ActiveCell.Formula = "=COUNTIF($B$2:$B$100,B2)"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E11"), Type:=xlFillDefault
Range("F1").Value = "Dub.Oder"
Range("F2").Select
ActiveCell.Formula = "=COUNTIF($B$2:B2,B2)/COUNTIF($B$2:$B$100,B2)"
Selection.AutoFill Destination:=Range("F2:F11"), Type:=xlFillDefault
Range("F2:F8").Select

Range("G2").Formula = "=LOOKUP(9^9,C:C,ROW(C:C))"
Range("H2").Value = "数のみに有効なデータ個数カウント、項目をあとで除外する必要あり。途中空白でもカウントする。"

Range("G3").Formula = "=LOOKUP(9^9,B:B,ROW(B:B))"
Range("H3").Value = "B列ではエラー"

Range("G4").Formula = "=COUNTA(C2:C100)"
Range("H4").Value = "空白がない場合はCountA。数字、文字どちらでもよい"
Range("G5").Formula = "=COUNTA(C2:C100)+COUNTBLANK(C2:C11)"
Range("H5").Value = "空白がある場合はCountA+COUNTBLANK。数字、文字どちらでもよい。正確な最終行が必要"
Range("G6").Formula = "=SUMPRODUCT(1/COUNTIF(B2:B11,B2:B11))"
Range("H6").Value = "各重複を各1行としてカウントした行数。空白なし。正確な最終行が必要"
Range("G7").Formula = "=SUMPRODUCT(1/COUNTIF($B$1:$B$100,$B$1:$B$100&""""))-(COUNTBLANK($B$1:$B$100)>0)-1"
Range("H7").Value = "各重複を各1行としてカウントした行数。空白はカウントしない。"
Range("G8").Formula = "=COUNTA(C2:C11)+COUNTBLANK(C2:C11)-COUNTIF(D2:D11,""★"")"
Range("H8").Value = "空白があってもよい、正確な最終行で重複チェック行を除外。重複を完全にのぞいた行数"
End Sub