エクセルのマクロで教えてください

質問

すみません。もし教えていただける方がいらっしゃればお願いいたします。以下のようなエクセルのデータがあるとします。
この中で，同じ担当者の最新の日付の行のみを抽出したデータのシートを作りたいのです。以下のデータであれば，2,3,5,6,8,9行目を削除するマクロを作成したいのですが，どのようなマクロを作成ればよいのでしょうか。

A 　 　　B 　 　C
1　 担当者　　　日付　　　金額
2　たなか　　　8/1　　　10,000
3　たなか　　　8/10　　 15,000
4　たなか　　　8/21　　 20,000
5　さとう　　　　8/2　　　 8,000
6　さとう　　　　8/12　　 12,000
7　さとう　　　　8/22　　 15,000
8　やまだ　　　8/1　　　 　9,000　　
9　やまだ　　　8/7　　　 12,000
10やまだ　　　8/15　　 18,000

回答No.1

keithin · ベストアンサー

ご利用のエクセルのバージョンが不明のご相談なので、エクセル２００７以降を使います

sub macro1()
’結果シートの準備
　activesheet.copy after:=activesheet
　with range("D2:D" & range("A65536").end(xlup).row)
　　.formula = "=ROW()"
　　.value = .value
　end with

’重複の削除
　range("A:D").sort key1:=range("B1"), order1:=xldescending, header:=xlyes
　range("A:D").removeduplicates columns:=1, header:=xlyes
　range("A:D").sort key1:=range("D1"), order1:=xlascending, header:=xlyes
　range("D:D").clearcontents
end sub

お礼

御教示いただき，誠にありがとうございました。御教示いただいたマクロを，じっくり勉強させていただきます。重ね重ねお礼申し上げます。

回答No.3

MackyNo1

抽出する名前の数が１０件程度なら、関数で処理することもできます。

添付画像のようなレイアウトなら、以下の関数を入力して下方向オートフィルします。

重複のない名前（E2セル）
=INDEX(A:A,SMALL(INDEX((MATCH($A$2:$A$20&"",$A$2:$A$20&"",0)<>ROW($A$2:$A$20)-1)*1000+ROW($A$2:$A$20),),ROW(1:1)))&""

対応する日付（F2セル）
=IF($E2="","",MAX(INDEX(($A$2:$A$20=E2)*($B$2:$B$20),)))

対応する金額（G2セル）
=IF(E2="","",SUMIFS($C$2:$C$20,$A$2:$A$20,E2,$B$2:$B$20,F2))

上記の式はデータが２０行目以内に記載されている場合ですが、実際のデータ数に合わせて、適宜20の数字を変更して下さい（必要以上に広い範囲を指定しない）。

＃ご使用のエクセルのバージョンが明記されていないので、ひとまずExcel2007以降で使用できる数式を提示しました。

お礼

御教示いただき，誠にありがとうございました。御教示いただいた関数を，じっくり勉強させていただきます。重ね重ねお礼申し上げます。

回答No.2

misatoanna

次のような内容でしょうか。

Sub Test()
Dim r As Long, rng As Range
Set rng = Cells(2, 1)
r = 3
Do While Cells(r, 1).Value <> ""
If Cells(r, 1).Value = Cells(r + 1, 1).Value Then
Set rng = Union(rng, Cells(r, 1))
End If
r = r + 1
Loop
rng.EntireRow.Delete
End Sub

お礼

御教示いただき，誠にありがとうございました。御教示いただいたマクロを，じっくり勉強させていただきます。重ね重ねお礼申し上げます。