Excel VBA質問箱 IV

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

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


27 / 13315 ツリー ←次へ | 前へ→

【80816】[無題] しいな 19/5/16(木) 22:14 質問[未読]

【80819】Re:[無題] マナ 19/5/16(木) 23:48 発言[未読]

【80819】Re:[無題]
発言  マナ  - 19/5/16(木) 23:48 -

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

こんな感じで

Option Explicit

Sub test()
  Dim dic As Object
  Dim ws As Worksheet
  Dim c As Range
  Dim e
  Dim n As Long
  Dim r As Range
  Dim fn
  Dim pvt As PivotTable
    
  Set dic = CreateObject("scripting.dictionary")
  
  Set ws = ActiveSheet

  For Each c In ws.Range("B1", ws.Range("B10000").End(xlUp))
    For Each e In Split(c.Offset(, 1).Value, ";")
      n = n + 1
      dic(n) = Array(c.Value, e)
    Next
  Next
  
  With ws.Cells(5)
    .CurrentRegion.ClearContents
    .Resize(n, 2).Value = Application.Index(dic.items, 0, 0)
    Set r = .CurrentRegion
  End With
  
  fn = Application.Index(r.Value, 1)
  
   With ws.Cells(8)
    .PivotTable.TableRange2.ClearContents
    Set pvt = .Parent.Parent.PivotCaches.Create(xlDatabase, r).CreatePivotTable(.Cells)
  End With

  With pvt
     .RowAxisLayout xlTabularRow
    .ColumnGrand = False

    .AddDataField .PivotFields(fn(2)), fn(2) & " ", xlCount
    .AddFields PageFields:=fn(1), RowFields:=fn(2)
  
  End With
  
End Sub

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