エクセル 最大値データのある行のみを残したい。

表題の質問をさせていただきます。よろしくお願いいたします。

Ａ列には商品名　Ｂ列には販売数があるとします。
商品には一回しか出てこない物や何度も出てくるものがあります。

そこで、販売数が最大値のみの重複しない商品データにする方法をお聞きしたいのです。
できれば非表示的な処理ではなく不要行削除が望ましいです。

例 下の場合
りんご 3（重複商品の最大値）
みかん 5（単独商品）
りんご 1
バナナ 6（単独商品）
りんご 2
イチゴ 2（重複商品の最大値）
イチゴ 1

↓にしたいのです。
りんご 3
みかん 5
バナナ 6
イチゴ 2

よろしくお願いいたします。

No.3 ベストアンサー 回答者： merlionXX 回答日時： 2009/03/15 12:41

No2 merlionXXです。

myDic自身が配列だったのでもっと簡潔な書き方が出来ました。
ご参考のため各コードにコメントも付けておきました。

Sub test02()
Dim myDic As Object '変数宣言
Dim c As Range '変数宣言
Set myDic = CreateObject("Scripting.Dictionary") 'myDicを用意
For Each c In Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) 'A列の各データについて
If Not myDic.exists(c.Value) Then 'myDicになければ
myDic.Add c.Value, c.Offset(0, 1).Value '追加しB列データを結びつける
Else 'myDicにあれば
myDic(c.Value) = IIf(myDic(c.Value) < c.Offset(0, 1).Value, c.Offset(0, 1).Value, myDic(c.Value)) 'B列データの大きい方を結びつける
End If
Next c '繰り返し
Set ns = Worksheets.Add(After:=ActiveSheet) 'シートを追加
ns.Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) 'A列にデータ
ns.Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Items) 'B列に結びつけデータ
Set myDic = Nothing
Set ns = Nothing
End Sub

この回答へのお礼

お返事ありがとうございます。

前日のお礼時に書いた内容までは、まだ解決できていないのですが、当初質問させていただいた内容については無事に解決いたしております。
時間が掛かると申し訳ないので、いちど締め切らせていただこうと思います。
この度は本当にありがとうございました。

お礼日時：2009/03/16 20:31

No.2 回答者： merlionXX 回答日時： 2009/03/15 10:37

VBAで行う一例です。

別シートを作成し、そこに抽出します。

Sub test02()
Dim myDic As Object
Dim c As Range
Dim myKey(), myItem()
Set myDic = CreateObject("Scripting.Dictionary")
For Each c In Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
If Not myDic.exists(c.Value) Then
myDic.Add c.Value, c.Offset(0, 1).Value
Else
myDic(c.Value) = IIf(myDic(c.Value) < c.Offset(0, 1).Value, c.Offset(0, 1).Value, myDic(c.Value))
End If
Next c
myKey() = myDic.Keys
myItem() = myDic.Items
' MsgBox Join(myKey()) & Join(myItem())
Set ns = Worksheets.Add(After:=ActiveSheet)
ns.Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myKey())
ns.Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myItem())
Set ns = Nothing
End Sub

この回答へのお礼

お返事ありがとうございます。

早速　試させていただき無事に動作が出来まして、今は勉強しながら既存シートへの上書きへの変更や商品名がＡ列に無いときなどの場合の実験をしているところでした。（ともに　うまくできました）

するとお礼をする前に次のお返事が入っており感激しているところです。
しかも、コードの解説付きで大感謝です。
さらに、参考にさせていただきながら改造をしてみようと思っております。
のちほど追加の質問をさせていただこうと思いますので　もしよろしければご教授の程よろしくお願いいたします。

ちなみに現在、格闘中の部分は　実際には列がたくさんあるので　A・B以上の列の場合と　最大値がＢ列に無い場合への改造を試しております。

お礼日時：2009/03/15 13:12

No.1 回答者： CoalTar 回答日時： 2009/03/14 22:41

案１

フィルタオプションの設定で重複レコードを削除し
配列数式で計算
=MAX(IF($A$2:$A$8=D2,$B$2:$B$8))
コピー&値の貼り付け

案２
ピボットテーブル案の最大値

案３
並べ替えて 集計を最大値で
は非表示なので没ですね

この回答へのお礼

お返事いただきありがとうございます。

全て試させていただいたところ、案1が良さそうだったのですけど　なかなか同じ動作が出来ずに　いろいろと　やっていたところ　ご提案を参考にさせていただきながら以下の方法で解決できました。

商品名を第一優先で販売数を降順で並べ替えておく。
フィルタオプションの設定を選択範囲にしました。

すると　どうにか思っていた結果に結びつけることが出来ました。
この度はありがとうございました、今後ともよろしくお願いいたします。

お礼日時：2009/03/15 08:09