Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


862 / 13645 ツリー ←次へ | 前へ→

【77877】ソートとフィルタの繰り返し処理 みか 16/1/16(土) 23:00 質問[未読]
【77878】Re:ソートとフィルタの繰り返し処理 γ 16/1/16(土) 23:04 発言[未読]
【77884】Re:ソートとフィルタの繰り返し処理 γ 16/1/17(日) 19:28 発言[未読]
【77886】Re:ソートとフィルタの繰り返し処理 γ 16/1/17(日) 20:24 発言[未読]
【77887】Re:ソートとフィルタの繰り返し処理 γ 16/1/17(日) 20:39 発言[未読]
【77888】Re:ソートとフィルタの繰り返し処理 みか 16/1/18(月) 8:35 お礼[未読]
【77889】Re:ソートとフィルタの繰り返し処理 γ 16/1/18(月) 20:44 発言[未読]
【77885】Re:ソートとフィルタの繰り返し処理 β 16/1/17(日) 20:03 発言[未読]

【77877】ソートとフィルタの繰り返し処理
質問  みか  - 16/1/16(土) 23:00 -

引用なし
パスワード
   大量に同じ処理を行わなければならないのですが、
どのようにVBAを書けばよいのか分かりません。
お手数をおかけしますが、ご教授いただけますと幸いです。

Sheet1に下記のように6列(A〜F列、H〜M列)をひとまとまりとし、
1列空けて、次の行からまた同じヘッダーのデータが入っています。


A列 B列 C列 D列 E列 F列  G列  H列 I列 J列 K列 L列 M列 …
------------------------------------------------------------------------------
日付 クラス 名前 性別 得点 順位 <空白> 日付 クラス 名前 性別 得点 順位 …
------------------------------------------------------------------------------
1/5 A  ●● 女  57        1/6 C △△ 男  78 
1/9 B  □□ 男  90        1/17 A ×× 男  95 


各まとまりごとに日付(昇順)、得点(降順)でソートした後、
順位列に日付毎の順位を入力し、オートフィルタで各日の順位が1〜3のデータを
Sheet2に張り付けるということを、繰り返したく思います。
また、Sheet1の列は今後増える可能性があるため、最終列を自動で取得したいです。

他のサイトなども見ながら奮闘中ですが
納期まで時間がなく困っております。お知恵をいただけますと幸いです。

【77878】Re:ソートとフィルタの繰り返し処理
発言  γ  - 16/1/16(土) 23:04 -

引用なし
パスワード
   ▼みか さん:
>他のサイトなども見ながら奮闘中ですが
A列からF列までを対象にして、できている、ないし奮闘中のコードを
提示してみてはいかがですか?

>納期まで時間がなく困っております。
納期ですか。

【77884】Re:ソートとフィルタの繰り返し処理
発言  γ  - 16/1/17(日) 19:28 -

引用なし
パスワード
   返事を待っていましたが、こちらも平日は時間が余り採れないし、
あきらめて、一例を書きます。
検証を十分にしていないので、そちらでよく検討してください。

なお、人に依頼するのであれば、
テストデータ(サンプルデータ)くらい提示してください。
また、ExcelのVersionも示す必要があります。

Sub test()
  Dim dic     As Object
  Dim k      As Long
  Dim r      As Range
  Dim myRange   As Range
  Dim myRange2  As Range
  Dim myRange3  As Range
  Dim e      As Variant
  Dim kaisu    As Long
  Dim c      As Long
  
  '現在のアクティブシートを作業対象とする(指定したほうがベターかも)
  
  'ブロックの数を取得
  kaisu = (Cells(1, Columns.Count).End(xlToLeft).Column + 1) \ 7
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  For k = 1 To kaisu
    c = 7 * (k - 1) + 1
    dic.RemoveAll
    
    '(1)重複を除いた日付を取得
    For Each r In Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
      dic(r.Value) = Empty
    Next
    
    '(2)日付(昇順)得点(降順)でソート
    Call mySort(c)
    
    '(3)各日付単位に、Rank.EQ関数を使って順位を付ける
    Set myRange = Cells(1, c).CurrentRegion       '見出しを含む表
    Set myRange2 = Intersect(myRange, myRange.Offset(1)) '見出し除く部分
    
    For Each e In dic.keys
      myRange.AutoFilter Field:=1, Operator:=xlFilterValues _
          , Criteria2:=Array(2, e)        '日付で抽出
      Set myRange3 = myRange2.Columns(5).SpecialCells(xlCellTypeVisible)
      
      '順位をつける(ワークシート関数Rank.EQを使う(同一順位を考慮))
      For Each r In myRange2.Columns(6).SpecialCells(xlCellTypeVisible)
        r.Value = Application.Rank_Eq(r.Offset(, -1), myRange3, 0)
      Next
      myRange.AutoFilter
    Next
    
    '(4)3位以内だけをSheet2に転記
    myRange.AutoFilter Field:=6, Criteria1:="<=3", Operator:=xlAnd
    myRange.Copy
    Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(2).PasteSpecial
    myRange.AutoFilter
  Next
End Sub

Function mySort(k As Long) '列目から始まるブロックに関してソート
  With ActiveSheet.Sort
    .SortFields.Clear
    
    '日付の昇順
    .SortFields.Add Key:=Cells(2, k) _
        , SortOn:=xlSortOnValues, Order:=xlAscending _
        , DataOption:=xlSortNormal
    
    '得点の降順
    .SortFields.Add Key:=Cells(2, k + 4) _
      , SortOn:=xlSortOnValues, Order:=xlDescending _
      , DataOption:=xlSortNormal
    
    .SetRange Cells(1, k).CurrentRegion
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
End Function

【77885】Re:ソートとフィルタの繰り返し処理
発言  β  - 16/1/17(日) 20:03 -

引用なし
パスワード
   ▼みか さん:

すでにγさんからコードも提示されていますので、これを元にして解決ということになろうかと思いますが念のため。

たとえば

A 100
B 100
C 100
D 90
E 90
F 80
G 80
H 70

こんな点数だったとして

考え方としては

A,B,Cが 1位、D,E は 4位
A.B,Cが 1位、D,E が 2位、F,G が 3位

いずれも、考え方としては間違っていませんね。
どちらの基準で考えるかにより、3位以内の人は、誰と誰なのかが違ってきます。

今回は、どちらで考えていますか?

【77886】Re:ソートとフィルタの繰り返し処理
発言  γ  - 16/1/17(日) 20:24 -

引用なし
パスワード
   βさんご指摘の点は、たしかに重要な検討ポイントですね。


2010で導入されたRANK.EQを使いましたので、
2007以前のバージョンでは動きません。
(それで、バージョン記載に言及しました。
 2007以前では単にRANK関数を使う)

ところで、今のコードでは、
元データをソートしてしまっています。

ソートしてはまずければ、
(1)元データのコピーを持っておくか
もしくは、
(2)ソートをせずに、
 (ソートしなくても順位判定、書き込みは可能。
  今のコードでそのまま動く。)
  Sheet2に転記してから、結果を
  日付(昇順)、得点(降順)で ソート
すれば良いはずです。

【77887】Re:ソートとフィルタの繰り返し処理
発言  γ  - 16/1/17(日) 20:39 -

引用なし
パスワード
   ちなみにテストデータと結果は以下のとおり。

テストデータ(Sheet1)
日付    クラス    名前    性別    得点    順位        日付    クラス    名前    性別    得点    順位
1月5日    A    c    女    95    1        1月5日    A    c    女    950    1
1月5日    A    b    男    80    2        1月5日    A    b    男    800    2
1月5日    B    d    男    60    3        1月5日    B    d    男    600    3
1月5日    A    a    女    57    4        1月5日    A    a    女    570    4
1月5日    C    e    女    57    4        1月5日    C    e    女    570    4
1月9日    A    b    男    100    1        1月9日    A    b    男    1000    1
1月9日    A    c    女    95    2        1月9日    A    c    女    950    2
1月9日    B    d    男    90    3        1月9日    A    a    女    950    2
1月9日    A    a    女    90    3        1月9日    B    d    男    900    4
1月9日    C    e    女    70    5        1月9日    A    a    女    900    4
                            1月9日    C    e    女    700    6

結果(Sheet2)============================
                    
                    
日付    クラス    名前    性別    得点    順位
1月5日    A    c    女    95    1
1月5日    A    b    男    80    2
1月5日    B    d    男    60    3
1月9日    A    b    男    100    1
1月9日    A    c    女    95    2
1月9日    B    d    男    90    3
1月9日    A    a    女    90    3
                    
日付    クラス    名前    性別    得点    順位
1月5日    A    c    女    950    1
1月5日    A    b    男    800    2
1月5日    B    d    男    600    3
1月9日    A    b    男    1000    1
1月9日    A    c    女    950    2
1月9日    A    a    女    950    2
  

【77888】Re:ソートとフィルタの繰り返し処理
お礼  みか  - 16/1/18(月) 8:35 -

引用なし
パスワード
   γ さん

返信が遅くなり大変申し訳ありません。
サンプルコードの件も、記載せず大変失礼いたしました。
以後気を付けます。

処理のほうも、いただいたもので無事にできました。
本当にありがとうございました。
取り急ぎお礼まで。

【77889】Re:ソートとフィルタの繰り返し処理
発言  γ  - 16/1/18(月) 20:44 -

引用なし
パスワード
   ▼みか さん:
>処理のほうも、いただいたもので無事にできました。
それはそれで結構なんですが、
なぜβさんが確認のコメントを下さっているのに反応がないのですか?
コードさえ貰えば、あとは野となれ山となれですか?
マナーを守って下さいな。

862 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free