エクセルで不要な行を自動で削除する

質問

エクセルを使った表で下記の様なデータがあります。
A列は番号、B列は来歴で、一番最後の文字(A0000の場合はB)の行が最新のデータになります。
例えばA0000の場合は始めのデータは「スニーカー」「サンダル」でしたが、Ａ改定で「パンプス」が加わり、
更にＢ改定で「スニーカー」と「パンプス」が無くなったので、最終のデータは「サンダル」だけになります。
自動でこの表を結果の様に、夫々の番号で最終の来歴だけを残す方法を教えて下さい。
行は4000行程あり、来歴は無しの物からJ位まであります。
又番号によってデータの行数も異なります。Ｄ列以降にもデータは入っています。
　　　　A　　　　B　　　　C　　　　D　　　E
1　　A0000　　-　　スニーカー
2　　A0000　　-　　サンダル
3　　A0000　　A　　スニーカー
4　　A0000　　A　　サンダル
5　　A0000　　A　　パンプス
6　　A0000　　B　　サンダル
7　　B0000　　-　　Tシャツ
8　　C0000　　-　　スーツ
9　　C0000　　A　　スーツ
10　　C0000　　A　　ドレス
11　　C0000　　A　　着物
12　　D0000　　-　　靴下
13　　D0000　　-　　ストッキング
　　：
　　：

結果(最終来歴だけのデータにする)
　　　　A　　　　B　　　　C　　　　D　　　E
1　　A0000　　B　　サンダル
2　　B0000　　-　　Tシャツ
3　　C0000　　A　　スーツ
4　　C0000　　A　　ドレス
5　　C0000　　A　　着物
6　　D0000　　-　　靴下
7　　D0000　　-　　ストッキング

現在並び替えて手作業で削除していますので、是非良い知恵をご教授下さい。

回答No.4

myRange · ベストアンサー

作業列を使わないでやる方法。

先ず、質問提示のサンプルでテストしてください。
　　見出し：１行目
　　データ：２行目以降
としてあります。

また、実際のデータで実行する場合は
当然ながらそれに応じてテーブル範囲など適宜修正のこと。

'--------------------------------------------------
Sub Test()
　Dim myDic1, myDic2
　Dim Akey1, Akey2
　Dim Target As Range
　Dim R As Long
　Dim LastRow As Long

　Set myDic1 = CreateObject("Scripting.Dictionary")
　Set myDic2 = CreateObject("Scripting.dictionary")

　LastRow = Cells(Rows.Count, "A").End(xlUp).Row

'▲▲必要ならソートのコードをここに挿入

　For R = LastRow To 2 Step -1
　　　Akey1 = Cells(R, "A").Value
　　　Akey2 = Cells(R, "A").Value & "@" & Cells(R, "B").Value
　　　If myDic1.exists(Akey1) = False Then
　　　　　myDic1.Add Akey1, ""
　　　　　myDic2.Add Akey2, ""
　　　Else
　　　　　If myDic2.exists(Akey2) = False Then
　　　　　　　If Target Is Nothing Then
　　　　　　　　　Set Target = Cells(R, "A")
　　　　　　　Else
　　　　　　　　　Set Target = Union(Target, Cells(R, "A"))
　　　　　　　End If
　　　　　End If
　　　End If
　Next R

　Target.EntireRow.Delete xlUp

End Sub
'------------------------------------------------------

第１キー（Ａ列）第２キー（Ｂ列）のソートが必要なら、
上記▲のところに、下記ソートコードを挿入すること。

'--------------------------------------------------
　Range("A1:C" & LastRow).Sort _
　　　　Key1:=Range("A2"), Order1:=xlAscending, _
　　　　Key2:=Range("B2"), Order2:=xlAscending, _
　　　　Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
　　　　Orientation:=xlTopToBottom, SortMethod:=xlPinYin
'-------------------------------------------------------

以上です。

お礼

ご回答ありがとうございました。
完璧です。やりたいそのままの事が実現出来ました。
本当にありがとうございました。

回答No.5

135ok

No.1です。
既に解決済みかと思いますが、関数で来歴の集計方法がわかりましたのでご参考として紹介いたします。

Ａ列に作業列を作り
Ａ２　=IF(C2="","",IF(LEFT(B2,1)=LEFT(B3,1),"",LEFT(B2,1)))
　　　*Ｃ列が空欄の時は空欄。Ｂ２の頭文字（Ａ）がＢ３の頭文がと同一文字の場合は空欄、以外はＢ２の頭文字を表示。

Ｇ２　=VLOOKUP(F2,$A:$D,3,0)
　　　*Ｆ列の文字を、Ａ列～Ｄ列の表から検索しＣ列の文字を表示。
後は、前回紹介した作業と同じです。
今回は、値をsheet2に表示させてあります。
参考資料ですので、コメントは不要です。

回答No.3

imogasi

例データ
A,B、C列
A0000 - スニーカー
A0000 - サンダル
A0000 A スニーカー
A0000 A サンダル
A0000 A パンプス
A0000 B サンダル 1
B0000 - Tシャツ 2
C0000 - スーツ
C0000 A スーツ
C0000 A ドレス
C0000 A 着物 3
D0000 - 靴下
D0000 - ストッキング 4
D2に　=IF(COUNTIF($A$2:A2,A2)=COUNTIF($A$2:$A$100,A2),MAX($D$1:D1)+1,"")
と式を入れて下方向に式を複写。仮にデータは第１００行までと仮定した式。実際は多めの行数に変えること。
結果
上記D列
あとはGoogleで「imogasi方式」で照会してもらえれば私の回答が沢山出てくる。
Sheet2のA2に
=INDEX(Sheet1!$A$1:$C$100,MATCH(ROW()-1,Sheet1!$D$1:$D$100,0),COLUMN())
C2まで式複写。
A2:C２の式をA5:C5の行まで式複写。
結果
A0000 B サンダル
B0000 - Tシャツ
C0000 A 着物
D0000 - ストッキング
ーー
やっていることは上からその行までのA0000の数と、列全体でのA0000の数が等しい（最下行に当たる）行に、上から、連番を振ったもの。
Sheet2では連番に対応したSheet１の行をもってきている。
＝＝＝
質問の文章部分は、「同じ顧客番号のうち最下行に位置する行のものだけを抜き出したい」と表現すれば読者に判りやすいのでは。
ーー

補足

ご回答ありがとうございます。
補足ですが今回導きたい答えは最終行では無く、最終来歴のデータ全て
なので、
C0000の場合は
C0000 A スーツ
C0000 A ドレス
C0000 A 着物
となって欲しいです。
imogasi方式での回答も是非知りたいので、再度ご回答頂けると嬉しいです。
よろしくお願い致します。

回答No.2

ASIMOV

VBAを使う方法です
A列を一時的に作業列として使います
A列の前に１列挿入し、下記のVBAを実行すると
図の様に、A列に残す行に「＠」が付きます
後は、フィルターで
１．「＠」行を抽出して、別シートにコピー
又は
２．「空白セル」行を抽出して、行削除
します
終了後はA列を「非表示」又は「列削除」します
-----------------------------------
Sub Ts()
　　lp = Range("B" & Rows.Count).End(xlUp).Row
　　Cells(lp, "A") = "@"
　　ban = Cells(lp, "B")
　　rai = Cells(lp, "C")
　　Do Until lp < 2
　　　　If ban = Cells(lp - 1, "B") Then
　　　　　　If rai = Cells(lp - 1, "C") Then
　　　　　　　　Cells(lp - 1, "A") = "@"
　　　　　　End If
　　　　Else
　　　　　　Cells(lp - 1, "A") = "@"
　　　　　　ban = Cells(lp - 1, "B")
　　　　　　rai = Cells(lp - 1, "C")
　　　　End If
　　　　lp = lp - 1
　　Loop
End Sub

お礼

ご回答ありがとうございました。
データ4000行に一瞬で「＠」マークが付き私の思う通りの結果になりました。
今までこの作業に毎回かなりの時間を費やしていましたので助かりました。
今後多いに活用させて頂きます。

回答No.1

135ok

ご参考程度で。
添付資料を参照ください。

「フィルタオプションの設定」を使うやり方です。
まず、項目をつけて表を作成する。
Ａ列から　番号　来歴　商品名

次に、Ｅ、Ｆ列に検索データを入力
Ｅ列　Ａから○○まで
Ｆ列　各番号の最終来歴を入力。

次に、データ→フィルタ→フィルタオプションの設定を選択。
抽出先　指定した範囲

リスト範囲　　$A:$C
検索条件範囲　$E$1:$F$5
抽出範囲　　　$H$1
なお、重複するレコードは無視するにチャックは入れない。

F列の最終来歴を自動で表示する方法が思いつきませんので、ご参考とさせていただきます。

参考URL：

http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter3.htm

お礼

早速のご回答ありがとうございました。
おっしゃる通りやりたかった事、すばりでは無かったのですが、今まで知らない機能なので
今後活用させて頂きたいと思います。
又参考ＵＲＬもじっくり読ませて頂こうと思います。