| |
▼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
|
|
kobasan
- 06/2/1(水) 21:05 -
