売上表エクセルから優良顧客を抽出する関数(画像有)

Question

お世話になります。

過去の売上表から優良顧客を抽出したいのですが
関数を組むことで実現可能であれば方法を教えて下さい。

・売上表はエクセル(excel2007)です。
・月ごとに１ファイル用意しています。
・ファイル内は日ごとに１シート用意しています。
　(2シート目が各月1日です。)
・シート内のレイアウトは以下です。
　【行】
　1行目：タイトル
　2行目：列タイトルを表記
　3行目以降：売れた商品ごとに1行ずつ表記
　※一人の客が複数着買った場合には服は1行ずつですが
　　列によっては複数行が統合されています。

【列】
　A～F列：色々
　G列：売れた商品名
　H列：定価
　I列：売値
　J列：客単価
　　　※一人の客が複数着買った場合には服はJ列は複数行統合されます。
　K列：総売上
　　　※行は統合されませんが服数着買った場合は最下行にのみセットされます。
　　　※客単位ではなくその時点での1日の総売上です。
　M列：顧客名
　　　※一人の客が複数着買った場合には服はM列は複数行統合されます。

となります。

この状況化で優良顧客を抽出したいです。

どのように抽出したいか、は以下です。

■各ファイル毎に最初のページのT列より右に検索結果を表示する
■一回で3万円以上購入した優良顧客を抽出する
■顧客名、購入金額を表示する
■購入日付(＝シート名)を表示する

今回の例であれば
山本アローナさん、紫藤フトコロンソさん、新藤ブスケッツさんが
抽出されて欲しいです。

関数に明るくないのでそもそも実現不可能なのかどうかがわかっていません。
もしエクセルでやるのがナンセンスで秀丸のGREP機能でこういう検索の
指定方法がある、などの事があればそういったご回答でも大歓迎です。
(GREPでは検索文字指定はできても3万円以上という範囲指定は
自分ではわかりませんでした。)

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

optimumsoup · Accepted Answer

下に二つのマクロがあります。もとのdataを安全のためにフラッシュメモリーなどに保存してから、はじめにマクロ１、ついでマクロ２を実行してみてください。
ただ(1)シート１のB1に2と入れておいてください(2)シート数はここでは4と指定していますがマクロ１とまくろ2のプログラムの中でsheetsu を所定の数に直してください。(3)シートのデータ数が一番多いのはいくつですか。マクロ2の中で10としていますが、適宜再指定してください。
どんな結果になるか試してみてください。

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2013/1/24  ユーザー名 :
'

'
Dim myshtno As Integer, sheetsu As Integer
sheetsu = 4
For myshtno = 2 To sheetsu

Worksheets(myshtno).Select
'MsgBox Range("A1:M4").Rows.Count

Range(Cells(1, 1), Cells(Rows.Count, 13)).Select
    Selection.Sort Key1:=Range("J2"), Order1:=xlDescending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin
        Next
End Sub
Sub Macro2()
'
' Macro2 Macro
' マクロ記録日 : 2013/1/25  ユーザー名 :
'
'
Dim myshtno As Integer, sheetsu As Integer, mygyo As Integer, endgyo As Integer
sheetsu = 4
For myshtno = 2 To sheetsu

'MsgBox Range("A1:M4").Rows.Count
For mygyo = 2 To 10

Worksheets(1).Select
endgyo = Cells(1, 2)
Worksheets(myshtno).Select
If Cells(mygyo, 10) >= 30000 Then
  Rows(mygyo).Select
    Selection.Copy
    Worksheets(1).Select
    Rows(endgyo).Select
    ActiveSheet.Paste
endgyo = endgyo + 1
Worksheets(1).Cells(1, 2) = endgyo
Else
End If
 
Next

optimumsoup · Answer

マクロ２で終わりに近いところで下のように　Exit For　を入れると計算時間が節約できるのではないかと考えつき、お伝えするために出てきました。

endgyo = endgyo + 1
Worksheets(1).Cells(1, 2) = endgyo
Else
Exit For
End If

マクロの組み込み方ですが、あなたのやり方が正式かもしれませんが、私がやっているのは
(1)ツールの中のマクロのところで新規マクロの記録を選び、そのまますぐに終了にします。
(2)ツールの中のマクロのところでマクロを選ぶと、先ほどつくったマクロがリストアップされていますので、それを指定して編集をすることにします。
(3)プログラムの本体部分に手に入れたマクロプログラムをコピー貼り付けをしプログラムとしての形式を整えます。
(4)保存した後
(5)ツールの中のマクロのところでマクロを選ぶと、先ほどつくったマクロがリストアップされていますので、指定して実行します。

そこで体裁はともかくとして、解決しなければならないところ、問題はどんなことでしょうか。ポイントを教えてください。

optimumsoup · Answer

試しに次のことをやってみてください。
1　N列に上から1、2、3と番号を振っておいてください。これは変になったとき元に戻すためです。
2　J列を基準として降順に並べ替えをしてください。(メニューバーのデータのなかの並べ替えの機能)
これで望みのデータが得られないでしょうか。
元に戻すのは　N列を基準に昇順に並べ替えをすればよいです。

売上表エクセルから優良顧客を抽出する関数(画像有)

下に二つのマクロがあります。

この回答への補足

マクロ２で終わりに近いところで下のように Exit For を入れると計算時間が節約できるのではないかと考えつき、お伝えするために出てきました。

試しに次のことをやってみてください。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

マクロ２で終わりに近いところで下のように　Exit For　を入れると計算時間が節約できるのではないかと考えつき、お伝えするために出てきました。