| 
    
     |  | kobasanさん、ありがとうございます。 きれいなプログラム!びっくりいたしました。
 もしよろしければ、コメントで詳細を説明していただけませんでしょうか?
 勝手を言って申し訳ございませんが、よろしくお願いいたします。
 
 
 ▼kobasan さん:
 >▼sakurako さん 今晩は。
 >
 >Sheet1について
 >機種をF列として作りました。
 >A列のデータは日付形式のデータとします。
 >
 >結果の書き出しはSheet2にしています。
 >
 >Sheet1
 > A       B     C      D        E       F
 >date      tester  kind    proname     ownstr     機種
 >2005/8/11 3:57  a1  LS_S  MTX1LP(A)_089    x30624fga    WHO
 >2005/8/11 4:10  a2  LS_S  MTX1LP(A)_089    x30833fjd3   BMO
 >2005/8/11 9:21  a3  LS_S  MTX1LP(A)_089    x30833fjd3   BMO
 >2005/8/11 9:41  a4  LS_S  MTX1LP(A)_089    x30833fjd3   FMC
 >2005/8/11 10:30  a5  LS_S  MTX1LP(A)_089    x30624fga    WHO
 >2005/8/11 14:59  a6  LS_S  MTX1LP(A)_089    x30624fga    WHO
 >2005/9/11 15:44  a7  LS_S  MTX1LP(A)_089    x30625fga    PLD
 >2005/9/11 16:26  a8  LS_S  MTX1LP(A)_089    x30626fga    DIO
 >
 >Sheet2
 >    TOTAL 2005/08 2005/09
 >WHO    3    3
 >BMO    2    2
 >FMC    1    1
 >PLD    1        1
 >DIO    1        1
 >
 >このような結果になります。
 >
 >試してみてください。
 >
 >Sub 集計()
 >Dim sh1 As Worksheet
 >Dim sh2 As Worksheet
 >Dim dicA As Object, dicF As Object, dic集計 As Object
 >Dim vnt, vntA, vntF
 >Dim i As Long, j As Long
 >Dim dd As String
 >  '
 >  Set sh1 = Sheets("Sheet1")
 >  Set sh2 = Sheets("Sheet2")
 >  '
 >  Set dicA = CreateObject("Scripting.Dictionary")
 >  Set dicF = CreateObject("Scripting.Dictionary")
 >  Set dic集計 = CreateObject("Scripting.Dictionary")
 >
 >  vntA = sh1.Range("A2", sh1.Range("A65536").End(xlUp)).Value
 >  vntF = sh1.Range("F2", sh1.Range("F65536").End(xlUp)).Value
 >  '
 >  For i = 1 To UBound(vntA)
 >    dd = "'" & Format(vntA(i, 1), "yyyy/mm")
 >    dicA(dd) = Empty
 >    dicF(vntF(i, 1)) = dicF(vntF(i, 1)) + 1
 >    dic集計(dd & vntF(i, 1)) = dic集計(dd & vntF(i, 1)) + 1
 >  Next i
 >  '
 >  sh2.Cells.ClearContents
 >  sh2.Range("A2").Resize(dicF.Count).Value = Application.Transpose(dicF.keys())
 >  sh2.Range("B1").Value = "TOTAL"
 >  sh2.Range("C1").Resize(, dicA.Count).NumberFormatLocal = "@"
 >  sh2.Range("C1").Resize(, dicA.Count).Value = dicA.keys()
 >  '
 >  vnt = sh2.Range("A1").CurrentRegion.Value
 >  For i = 2 To UBound(vnt, 1)
 >  For j = 2 To UBound(vnt, 2)
 >    vnt(i, j) = dic集計("'" & vnt(1, j) & vnt(i, 1))
 >  Next
 >  Next i
 >  sh2.Range("A1").CurrentRegion.Value = vnt
 >  sh2.Range("B2").Resize(dicF.Count, 1).Value = Application.Transpose(dicF.items)
 >  sh2.Select
 >  '
 >  Set sh1 = Nothing
 >  Set sh2 = Nothing
 >  Set dicA = Nothing
 >  Set dicF = Nothing
 >  Set dic集計 = Nothing
 >End Sub
 
 |  |