Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1342 / 76734

←次へ　｜　前へ→


	【81043】Re:データベースから表を作成したのですが

マナ - 19/7/24(水) 17:49 -


	引用なし

	パスワード

▼Aces さん：

>何か他に良い方法はあるでしょうか？

Dictionaryを利用するのが、簡単です。
Q&A自掲示板では、よく使われています。
でも、初めてだと全くわからないかもしれません。

Sub test()
　　Dim tbl, 抽出条件 As Range, 抽出先 As Range
　　Dim w()
　　Dim dicX As Object, dicY As Object
　　Dim 日付, 項目 As String, 数量 As String
　　Dim k As Long
　
　　tbl = Worksheets("詳細").Range("a2").CurrentRegion.Value
　　Set 抽出条件 = Worksheets("見出し").Range("a2").CurrentRegion
　　Set 抽出先 = Worksheets("一覧").Range("a2")
　　
　　ReDim w(1 To UBound(tbl), 1 To UBound(tbl))
　　
　　Set dicX = CreateObject("scripting.dictionary")
　　Set dicY = CreateObject("scripting.dictionary")

　　For k = 1 To UBound(tbl)
　　　　日付 = tbl(k, 1)
　　　　項目 = tbl(k, 3)
　　　　数量 = tbl(k, 4)
　　　　
　　　　If WorksheetFunction.CountIf(抽出条件, 日付) Then
　　　　　　If Not dicX.exists(日付) Then
　　　　　　　　dicX(日付) = dicX.Count + 1
　　　　　　　　w(1, dicX(日付)) = 日付
　　　　　　End If
　　　　　　If Not dicY.exists(項目) Then
　　　　　　　　dicY(項目) = dicY.Count + 1
　　　　　　　　w(dicY(項目), 1) = 項目
　　　　　　End If
　　　　　　
　　　　　　w(dicY(項目), dicX(日付)) = 数量
　　　　　　
　　　　End If
　　Next
　　w(1, 1) = "項目/日付"
　　
　　抽出先.CurrentRegion.ClearContents
　　抽出先.Resize(dicY.Count, dicX.Count).Value = w
　　
End Sub

9 hits

▼

【81037】データベースから表を作成したのですが Aces 19/7/23(火) 16:33