Excel VBA質問箱 IV

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

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


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

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

【80817】Re:[無題] マナ 19/5/16(木) 23:04 発言[未読]
【80819】Re:[無題] マナ 19/5/16(木) 23:48 発言[未読]
【80820】Re:[無題] しいな 19/5/17(金) 9:16 質問[未読]
【80821】Re:[無題] マナ 19/5/17(金) 19:24 発言[未読]
【80823】Re:[無題] マナ 19/5/17(金) 21:55 発言[未読]
【80832】Re:[無題] しいな 19/5/19(日) 22:53 お礼[未読]

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

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

>【ピボットテーブル】
>フィルターにB列
>行に値
>値にC列の個数の合計
>
>を指定しています。

ピボットで、A列は使用しないということで間違いないですか?

【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

【80820】Re:[無題]
質問  しいな  - 19/5/17(金) 9:16 -

引用なし
パスワード
   ▼マナ さん:
素晴らしいものを作成いただきありがとうございます。
説明不足で申し訳ありません。
A列はピボットの列に指定しております。
本当に申し訳ありません


>▼しいな さん:
>
>>【ピボットテーブル】
>>フィルターにB列
>>行に値
>>値にC列の個数の合計
>>
>>を指定しています。
>
>ピボットで、A列は使用しないということで間違いないですか?

【80821】Re:[無題]
発言  マナ  - 19/5/17(金) 19:24 -

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

あくまで、たたき台です。
要望と違う部分は、修正してください。

Option Explicit

Sub test2()
  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("a1", ws.Range("a10000").End(xlUp))
    For Each e In Split(c.Offset(, 2).Value, ";")
      n = n + 1
      dic(n) = Array(c.Value, c.Offset(, 1).Value, e)
    Next
  Next
  
  With ws.Cells(5)
    .CurrentRegion.ClearContents
    .Resize(n, 3).Value = Application.Index(dic.items, 0, 0)
    Set r = .CurrentRegion
  End With
  
  fn = Application.Index(r.Value, 1)
  
   With ws.Cells(9)
    On Error Resume Next
    .PivotTable.TableRange2.ClearContents
    On Error GoTo 0
    Set pvt = .Parent.Parent.PivotCaches.Create(xlDatabase, r).CreatePivotTable(.Cells)
  End With

  With pvt
     .RowAxisLayout xlTabularRow
     .RowGrand = False
    .ColumnGrand = False
    
    .AddDataField .PivotFields(fn(2)), fn(2) & " ", xlCount
    .AddFields PageFields:=fn(2), RowFields:=fn(3), ColumnFields:=fn(1)
  
  End With
  
End Sub

【80823】Re:[無題]
発言  マナ  - 19/5/17(金) 21:55 -

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

ごめんなさい。毎回ピボットを作り直す必要なかったです。
最初に、手作業で作っておけば、

ws.Cells(9).PivotTable.SourceData = r.Address(, , xlR1C1, True)

これだけで十分でした。

【80832】Re:[無題]
お礼  しいな  - 19/5/19(日) 22:53 -

引用なし
パスワード
   ▼マナ さん:
マナさんご丁寧にありがとうございました。今VBAの本と照らし合わせながら、こうやって作っていくんだと勉強させていただいています。
本当に奥が深くて勉強になります。ありがとうございました。


>▼しいな さん:
>
>ごめんなさい。毎回ピボットを作り直す必要なかったです。
>最初に、手作業で作っておけば、
>
>ws.Cells(9).PivotTable.SourceData = r.Address(, , xlR1C1, True)
>
>これだけで十分でした。

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