顧客データをテーブルデータに加工するのにマクロを使いたいのですが

顧客データが数万件あるのですが、エクセルで使用するのにデータをテープル化したいと思っています。

具体的には、下記のようになっています。
Ａ列に、住所
Ｂ列に、名前

このデータは、ダブりがあるため、
①Ａ列基準にＡＢ列を昇順にソートをかけています。
②Ａ列の同じ住所の範囲内で、Ｂ列に昇順にソートをかけ、Ｂ列のダブりを排除します。
③Ａ列の住所はＤ１(２回目はＥ１へと言う具合に順送り)へ、
　Ｂ列のダブりが無くなった名前はＤ２～Ｄ∞(２回目以降はＥ２～Ｅ∞という具合に順送り)へと
　移動させます。
④①～③を同じ住所で繰り返します。

※D1が住所、D2～Ｄ∞が同じ住所のダブりの無い顧客名になります。
　最終的にはＡ列は件数を表示して、Ｂ列から始まるようにするつもりなので、
　最初にあるＡ・Ｂ列のデータは移動という形で無くなってしまうことになります。

これを手作業ですると、いやもう、手作業の力業で１万件くらいしたのですが、
さすがに頭がくらくらしています。

手作業では、Ａ列の同じ住所の範囲をＢ列でドラッグし、並び替えた後、
重複を削除し、それぞれを任意の場所へ移動させています。

これをマクロでできないかと考えていますが、どうしたらいいでしょぅか。

No.2 ベストアンサー 回答者： fujillin 回答日時： 2018/04/10 13:25

こんにちは

多分関数だけでも実現できそうに思いますが、データが数万件（行）あると関数式を設定するのも（オートフィルでも）ひと作業になりそうなので、ご質問通りVBAで考えてみました。

しかしながら、ご説明文を読んでも、なんだかややこしくてよくわからないので、
＞D1が住所、D2～Ｄ∞が同じ住所のダブりの無い顧客名になります
だけを頼りに作成しようと考えましたが、「D2～Ｄ∞」というのと、
＞③Ａ列の住所はＤ１(２回目はＥ１へと言う具合に順送り)へ
とが、意味合いが全く異なるので、結局、勝手に解釈することにしてしまいました。

とりあえず、D列に重複しない住所、E列～（E,F,G…）に重複しない名前を表示するようにしてあります。
処理方法は、ご説明の方法とは全く違う手順で行っていますが悪しからず。
また、単純な文字列比較で判断していますので、表記方法の違いやスペースの有無でも異なるものと判断されます。
例えば以下の組み合わせは、全て異なるものとして判断されます。
　東京都千代田区　と　東京都 千代田区
　1丁目1番地　　　と　1-1
　株式会社　　　　と　（株）
など。

私の解釈が、はたしてお望みの内容に合っているのかすらよくわかっていませんので、まずは簡単なデータで試してみてください。
また、元データ（A、B列）も削除してしまいますので、ご注意ください。
Sub Sample()
Dim tRng As Range, tmp As Range, rw As Long

rw = Cells(Rows.Count, 1).End(xlUp).Row
Set tRng = Range("A1").Resize(rw, 2)

Application.ScreenUpdating = False

Range("C:E").ClearContents
tRng.Sort Key1:=Range("A1"), Header:=xlNo, key2:=Range("B1")
tRng.Columns(1).Offset(1, 2).Formula = "=(A1=A2)"
tRng.Columns(2).Offset(1, 2).Formula = "=AND(A1=A2,B1=B2)"

For rw = 1 To tRng.Rows.Count
　If Not Cells(rw, 3) Then Set tmp = Cells(rw, 5)
　If Not Cells(rw, 4) Then
　　tmp.Value = Cells(rw, 2).Value
　　Set tmp = tmp.Offset(0, 1)
　End If
Next rw

tRng.Columns(1).Offset(0, 4).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("B:D").Delete
Range("A:C").Insert
Range("D1").Select

Application.ScreenUpdating = True

End Sub

この回答へのお礼

ありがとうございます。

私の説明が分かりにくかったせいか、結果はＡ列に住所、Ｂ列から順にＣ・・・にお客様名が同じ住所内でソートされた結果となりました。
これはこれでいいのですが、質問で説明させていただいたようにするには、その結果をコピーして貼り付け時に縦横反転することで希望通りとなりました。

とりあえず、ある区をサンプルにしてみたところ、少し手を加えればちゃんとお客様リストテーブルは出来そうです。
これはすごく時間短縮になりました。
ありがとうございました。

私もこのようなことが自分で出来るようになりたいのですが、どうやって学べばよいのやら機会もなく、方法もわからず困っているのが現状です。

お礼日時：2018/04/10 23:35

No.3 回答者： tom04 回答日時： 2018/04/10 13:29

こんにちは！

元データはSheet1にあり、Sheet2に表示するとします。
尚、Sheet1の1行目は項目行でデータは2行目以降にあるという前提です。
標準モジュールにしてください。

Sub Sample1()
Dim myDic As Object
Dim i As Long, k As Long, lastRow As Long
Dim wS As Worksheet
Dim myKey, myItem, myAry, myR
Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
myR = Range(.Cells(2, "A"), .Cells(lastRow, "B"))
For i = 1 To UBound(myR, 1)
If Not myDic.exists(myR(i, 1)) Then
myDic.Add myR(i, 1), myR(i, 2)
Else
If InStr(myDic(myR(i, 1)), myR(i, 2)) = 0 Then
myDic(myR(i, 1)) = myDic(myR(i, 1)) & "_" & myR(i, 2)
End If
End If
Next i
End With
myKey = myDic.keys
myItem = myDic.items
For i = 0 To UBound(myKey)
myAry = Split(myItem(i), "_")
wS.Cells(i + 1, "A") = myKey(i)
For k = 0 To UBound(myAry)
wS.Cells(i + 1, k + 2) = myAry(k)
Next k
Next i
Set myDic = Nothing
wS.Columns.AutoFit
wS.Activate
MsgBox "完了"
End Sub

こんな感じで良いのでしょうかね？

※　Sheet1の並び替えは不要ですが、
表示されるのは出現順となります。m(_ _)m

この回答へのお礼

ありがとうございます。
仰るとおり、

＞表示されるのは出現順となります。

名前部分にソートが掛かっておらず、結果の住所毎のお客様名で個別にソートを書けなければならず、
不十分な結果でした。

お礼日時：2018/04/10 23:28

No.1 回答者： d-q-t-p 回答日時： 2018/04/10 12:59

> マクロでできないかと考えていますが、どうしたらいいでしょぅか。

VBAの知識がないならまずは基本だけでも勉強して下さい。
知識のない人がマクロを扱うのは無謀です。

ただこれ Googleスプレッドシートなら 関数だけで解決する話だと思
いますけど。 SORT・UNIQUE・TRANSPOSE・FILTER。