住所録で同じ住所のデータを家族にできますか？

質問

csvファイルで住所録のデータがあります。

個人別のデータで、氏名、郵便番号、住所の項目があり、
家族であれば住所は同じデータになっています。

これを宛名ソフトでよくあるように、氏名１、氏名２、氏名３、郵便番号、住所、
のようにしたいのですが、なにか良い方法はありますでしょうか。

私はエクセルは関数やマクロの簡単なものなら理解でき、
アクセスも少し触ったことはありますが、プログラムを作ることはできません。

エクセルの操作やアクセスでできる方法があれば教えてください。

よろしくお願いします。

回答No.1

tom04 · ベストアンサー

こんばんは！
VBAでの一例です。

CSVファイルをExcelで開き
↓の画像で元データが左側のSheetのようになっているとします。
マクロを実行すると右側のような表示になるようにしてみました。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー％ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, endCol As Long
Range("A1").CurrentRegion.Sort key1:=Range("B1"), order1:=xlAscending, Header:=xlYes, _
key2:=Range("C1"), order1:=xlAscending, Header:=xlYes
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
If Cells(i, "C") = Cells(i - 1, "C") Then
Cells(i - 1, "D") = Cells(i, "A")
endCol = Cells(i, Columns.Count).End(xlToLeft).Column
If endCol > 3 Then
Range(Cells(i, "D"), Cells(i, endCol)).Cut Cells(i - 1, Columns.Count).End(xlToLeft).Offset(, 1)
End If
Rows(i).Delete
End If
Next i
endCol = ActiveSheet.UsedRange.Columns.Count
If endCol > 3 Then
Range(Columns(2), Columns(endCol - 2)).Insert
End If
Range("A1") = "氏名1"
For j = 2 To endCol - 2
Cells(1, j) = "氏名" & j
Next j
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, endCol + 1).Resize(, endCol - 3).Cut Cells(i, "B")
Next i
Columns.AutoFit
End Sub 'この行まで

※　C列の住所が一致しているデータをおなじ行に表示するようにしています。
※　一旦マクロを実行すると元に戻せませんので別Sheetでマクロを試してください。

こんな感じではどうでしょうか？m(_ _)m

回答No.4

yomyom01

・シート1にCSVを読み込んでそこからシート2に
氏名１、氏名２、氏名３、郵便番号、住所
の形で貼り付けてCSVで保存する

回答No.3

bunjii

>これを宛名ソフトでよくあるように、氏名１、氏名２、氏名３、郵便番号、住所、のようにしたいのですが、なにか良い方法はありますでしょうか。
関数の組み合わせでも目的のように処理できます。
予め関数を組み込んだシートを用意して、テキストデータを読み込む方法が良いと思います。

A列～C列はテキストデータの読み込みテーブルとします。
D列に住所を単一化するためのインデックスに使います。
1行目は項目（フィールド）名となりますので2行目以降が実際のデータになります。

D2=IF(COUNTIF(C$2:C2,C2)=1,ROW(),"")

郵便番号（H列）と住所（I列）は同じ方法で抽出します。

H2=IFERROR(INDEX(B:B,SMALL($D:$D,ROWS($D$2:$D2))),"")
H2セルをI2セルへコピーし、下へ必要数だけコピーします。

氏名1（E列）～氏名3（G列）は同じ方法で抽出します。

E2=IFERROR(INDEX($A:$A,SMALL(IF($C:$C=$I2,ROW(C$1:C$100),""),COLUMNS($E1:E1))),"")
入れ子内のIF関数は配列値を返す必要があるので式を入力した後でCtrl+Shift+Enterで確定します。
E2セルを右へG2セルまでコピーし、3つのセルを同時に下へ必要数だけコピーすれば目的通りになります。

問題点は氏名1～氏名3が同姓のとき名前のみにしたくなると思います。
この問題については別途処理が必要になります。

動作テストにExcel 2013を使いましたので、Excel 2003以前のバージョンでは使えない関数も含まれています。

回答No.2

keithin

シート１に元データとして
Ａ列に名前、Ｂ列に郵便番号、Ｃ列に住所として

sub macro1()
　dim w as worksheet
　dim h as range
　dim Target as range
　dim lastRow as long
　dim c as long, cc as long

’準備
　set w = activesheet
　lastrow = range("A65536").end(xlup).row
　worksheets.add after:=worksheets(worksheets.count)

’本体
　w.range("B:C").advancedfilter action:=xlfiltercopy, copytorange:=range("A1"), unique:=true
　for each h in w.range("C1:C" & lastrow)
　　set target = range("B:B").find(what:=h.value, lookin:=xlvalues, lookat:=xlwhole)
　　cells(target.row, "IV").end(xltoleft).offset(0, 1).value = h.offset(0, -2).value
　next

’飾り付け
　c = cells.specialcells(xlcelltypelastcell).column
　range(range("C1"), cells(1, c)).entirecolumn.cut
　range("A:A").insert
　for cc = 1 to c - 2
　　cells(1, cc) = "name" & cc
　next cc

end sub

＃業務のメインボディより（どーでもいい）飾りの方が手間がかかります