Excel VBA質問箱 IV

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

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


47299 / 76732 ←次へ | 前へ→

【34393】Re:月ごとのデータ集計
回答  kobasan  - 06/2/1(水) 21:05 -

引用なし
パスワード
   ▼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

0 hits

【34378】月ごとのデータ集計 sakurako 06/2/1(水) 16:36 質問
【34379】Re:月ごとのデータ集計 sakurako 06/2/1(水) 16:39 質問
【34387】Re:月ごとのデータ集計 ゆと 06/2/1(水) 20:05 発言
【34382】Re:月ごとのデータ集計 inoue 06/2/1(水) 17:08 発言
【34393】Re:月ごとのデータ集計 kobasan 06/2/1(水) 21:05 回答
【34411】Re:月ごとのデータ集計 sakurako 06/2/2(木) 8:46 質問
【34469】Re:月ごとのデータ集計 sakurako 06/2/3(金) 11:54 お礼

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