[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『上位データの抽出』(n)
数万単位のデータの中から以下の抽出を行いたいのですが、良い案がないため教えていただきたいです。
A列/B列/C列
個人名/利用金額/利用店舗
のデータがあるとします。
利用店舗は何百あるのですが、その各店舗ごとに利用金額の多い購入者を抽出したいです。
利用金額をただ降順にすると利用店舗ごとの抽出ができません。
拙い説明で申し訳ありません。よろしくお願いいたします。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
抽出ではないですが、 降順に並べる 店舗でフィルター コピーして貼り付け 店舗でフィルター コピーして貼り付け を繰り返すマクロです。
上位10人だけでいいとかそういうのはまず実行してみてから考えてくださいー
Sub 店舗別優良顧客順一覧出力() Dim 店舗一覧 As Variant Dim wsIN As Worksheet, wsOUT As Worksheet Dim k As Variant, dic As Object: Set dic = CreateObject("Scripting.Dictionary") Dim i As Long, cnt As Long Set wsIN = Sheets("データ") With wsIN If .FilterMode = True Then .ShowAllData '重複しない店舗名一覧を作成 店舗一覧 = .Range("C1", .Cells(Rows.Count, "C").End(xlUp)).Value For i = 2 To UBound(店舗一覧, 1) dic(店舗一覧(i, 1)) = "" Next i
'降順で並び替え If .AutoFilterMode = False Then .Range("A1").CurrentRegion.AutoFilter End If .AutoFilter.Sort.SortFields.Add _ Key:=.Range("B1", .Cells(Rows.Count, "B").End(xlUp)), _ SortOn:=xlSortOnValues, _ Order:=xlDescending, _ DataOption:=xlSortTextAsNumbers
'新しいシートを作る Sheets.Add after:=Sheets(Sheets.Count) Set wsOUT = Sheets(Sheets.Count)
'タイトルを新しいシートに項目を入れる wsOUT.Range("A1:C1").Value = wsIN.Range("A1:C1").Value Application.Calculation = xlCalculationManual
'各店舗でフィルターして、新しいシートにコピー For Each k In dic.keys .Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=k Intersect(wsIN.AutoFilter.Range, wsIN.AutoFilter.Range.Offset(1)).SpecialCells(xlCellTypeVisible).Copy wsOUT.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlValues Next k Application.Calculation = xlCalculationAutomatic End With MsgBox "出力しました" End Sub
(稲葉) 2023/03/15(水) 16:00:19
すでにマクロ案をいただいていますが、手作業方式でこんなのはどうですか?
D列に、「ランク」という列を設け、 =COUNTIF($C$2:C2,C2)という式を下にコピーしておきます。
(1)ソートします ・利用店舗を第一キー(昇順、でもユーザー定義リストでもなんでも可) ・利用金額を第二キー(降順) としてソートします、 (2)すると、店舗ごとに金額多い順のリストが出ますから、 トップスリーなら、D列にオートフィルタを掛けて、 数値フィルタで3以下とすれば、トップスリーだけの表が得られます。 トップファイブなら、5以下とします。 こんな感じでどうでしょうか。
(abc) 2023/03/15(水) 23:26:37
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.