GBKEE

¦^´_ 4# ii31sakura


   

²Î­p¥X²{³Ì¦h¦¸¼Æ¥Ø»P¶µ¥Ø

·í¥X²{³Ì¦h¦¸¼Æ¥Ø¤£¥u£¸¶µ®É

1. Sub Test()
   
2.   Dim r As Long, sCond As String
   
3.   Dim d As Object, k As Variant
   
4.   Set d = CreateObject("scripting.dictionary")
   
5.   With Sheets("Data")
   
6.     sCond = .[G1].Text
   
7.     r = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
   
8.     If r <= 0 Then Exit Sub
   
9.     For Each s In .[A2].Resize(r).Value
   
10.       If sCond = Split(s, "-")(0) Then d(s) = d(s) + 1
    
11.     Next
    
12.     r = 0
    
13.     For Each k In d.keys
    
14.         If d(k) = Application.WorksheetFunction.max(d.ITEMS) Then '¥X²{³Ì¦h¦¸¼Æ¥Ø
    
15.             With .[J1].Offset(, r)
    
16.                .Value = Split(k, "-")(1)
    
17.                 .Offset(1).Value = d(k)
    
18.             End With
    
19.             r = r + 1
    
20.         End If
    
21.     Next
    
22.   End With
    
23. End Sub

½Æ»s¥N½X