[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAデータに該当得意先があったら、以下処理を行いたい』（ピノ）
VBA初心者です。
いつも参考にさせていただいております。
マクロを動かした時間に受注データにある得意先のみに、
以下処理を行いたいです。
構文構成が思いつかず、ヒントをいただきたいです。
＜条件＞
・得意先により受注時間が異なるため、
マクロを動かした時間に、受注データに存在する得意先のみに以下処理を実施。
・得意先は、マスタファイル.xlsmに記載の得意先以外は存在しません。
ただ今後得意先が増える可能性があるので、マスタファイルに追記すれば追加で処理できるようにしたいです。
＜マスタファイル.xlsm＞
A B C D E F
得意先コード 得意先名 仕入先ＣＤ 仕入先名 得意先店舗CD桁数 1 1 得意先１ 111111 A社 0000 2 1 得意先１ 222222 B社 0000 3 2 得意先２ 111111 A社 000 4 2 得意先２ 222222 B社 000 5 2 得意先２ 333333 C社 000 6 3 得意先３ 111111 A社 00000
＜受注リスト＞
1 A B C D E F H I J K L
2 出荷日 専伝ＮＯ 得意先店舗コード 得意先名カナ 物流センタコード 商品コード 商品名カナ ケース入数 ボール入数 引当数個数 相手商品コード
3 20200302 882476786 0700 得意先１ﾌｼﾞﾃﾝ 000002 225675 りんご 1 0 1 0900000
4 20200302 882476786 1311 得意先１ﾌﾞﾝｼﾞﾃﾝ 000003 225675 りんご 1 0 1 0900000
＜やりたいこと＞
◆受注リスト.xlsxの前はテキスト形式の生データ。店舗コード桁数設定。（店舗コード：J列）
※桁数設定は、マクロファイル・マスタシートG列「店舗CD桁数」に記載の桁数を設定。
必要列以外を削除
データを得意先CD別・仕入先CD別に分解（得意先CD：I列、仕入先CD：Y列）
タイトル行にフィルター設定
◆受注商品一覧シートを元に、隣に商品サマリシートを作成
ピボットテーブルにて商品別数量一覧を作成し、値貼付けにする。（マクロ記録で作成済み）
ピボットテーブルの上に見出しをつける
タイトル項目：マクロファイル・マスタシートE列「仕入先名」をB2セル、「仕入先CD」をB1セルに表示）
それ以外は統一
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
大変申し訳ありませんが、＜やりたいこと＞ はこちらを参照お願いいたします。
＜やりたいこと＞
◆受注リスト.xlsxのC列店舗コード桁数設定
桁数設定は、マスタファイルF列「店舗CD桁数」に記載の桁数を設定。
◆受注リストに記載の得意先CD別・仕入先CD別にデータを分解し、シート名を「受注商品一覧」とする。
（得意先CD：I列、仕入先CD：Y列）
◆受注商品一覧シートを元に、隣に「商品サマリ」シートを作成
ピボットテーブルにて商品別数量一覧を作成し、値貼付けにする。（マクロ記録で作成済み）
◆ピボットテーブルの上に見出しをつける
タイトル項目：マスタファイルD列「仕入先名」を商品サマリシートのB2セルに、 マスタファイルE列「仕入先CD」をB1セルに表示
◆名前を付けて保存。ファイル名：本日日付（yyyymmdd）＋仕入先名＋様＋得意先名＋店別データ.xlsx
（ピノ） 2020/03/20(金) 23:48
Sub 商品サマリシートを作成()
'
Windows("得意先２店別データ.xlsx").Activate
Range("A1").Select
'変数宣言（１行列目の最終行列取得）
LR = Cells(Rows.Count 1).End(xlUp).Row
LC = Cells(1 Columns.Count).End(xlToLeft).Column
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase SourceData:= _
"得意先２店別データ!R1C1:R" & LR & "C" & LC Version:=6).CreatePivotTable TableDestination:= _
"Sheet1!R3C1" TableName:="ピボットテーブル3" DefaultVersion:=6
Sheets("Sheet1").Select
Cells(3 1).Select
Range("B10").Select
With ActiveSheet.PivotTables("ピボットテーブル3")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
With ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("出荷日 ")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("商品コード")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("商品名カナ ")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("ケース入数")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("ボール入数")
.Orientation = xlRowField
.Position = 5
End With
ActiveSheet.PivotTables("ピボットテーブル3").AddDataField ActiveSheet.PivotTables( _
"ピボットテーブル3").PivotFields("引当数個数") "データの個数 / 引当数個数" xlCount
With ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("データの個数 / 引当数個数")
.Caption = "合計 / 引当数個数"
.Function = xlSum
End With
'小計表示をなくす
Windows("得意先２店別データ.xlsx").Activate
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("出荷日 ").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("専伝ＮＯ ").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("得意先店舗コード").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("得意先名カナ ").Subtotals _
= Array(False False False
)
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("物流センタコード").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("商品コード").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("商品名カナ ").Subtotals = _
Array(False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("ケース入数").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("ボール入数").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("引当数個数").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("相手商品コード").Subtotals = Array( _
False False False
ActiveSheet.PivotTables("ピボットテーブル3").PivotFields(" ").Subtotals = Array(False _
False False False
'列幅調整
Columns("A:A").ColumnWidth = 14.13
'ピボットテーブルを値貼り付け
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues Operation:=xlNone SkipBlanks _
:=False Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
'シート名変更
ActiveCell.FormulaR1C1 = ""
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "商品サマリ"
（ピノ） 2020/03/20(金) 23:54
おはようございます ＾＾ けっこう大掛かりなようですね。。。頑張ってください。 ご提示の情報整理のお手伝いだけでも ＾＾；
マスタファイル.xlsm Sheet1 想像図
|[A] |[B] |[C] |[D] |[E]
[1]|得意先コード|得意先名|仕入先ＣＤ|仕入先名|得意先店舗CD桁数
[2]| 1|得意先１| 111111|A社 | 0000
[3]| 1|得意先１| 222222|B社 | 0000
[4]| 2|得意先２| 111111|A社 | 000
[5]| 2|得意先２| 222222|B社 | 000
[6]| 2|得意先２| 333333|C社 | 000
[7]| 3|得意先３| 111111|A社 | 00000
受注リスト.xlsx Sheet1 想像図
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K]
[1]|出荷日 |専伝ＮＯ |得意先店舗コード|得意先名カナ |物流センタコード|商品コード|商品名カナ|ケース入数|ボール入数|引当数個数|相手商品コード
[2]|20200302| 882476786| 700|得意先１ﾌｼﾞﾃﾝ | 2| 225675|りんご | 1| 0| 1| 900000
[3]|20200302| 882476786| 1311|得意先１ﾌﾞﾝｼﾞﾃﾝ| 3| 225675|りんご | 1| 0| 1| 900000
違う点等、ご修正くださいませ。たくさんアドバイス、回答があるといいですね。でわ m(_ _)m （隠居じーさん） 2020/03/21(土) 07:06
〇〇.Select ActiveSheet.〇〇
のようになっていますが、基本的にVBAの世界では対象オブジェクトをきちんと書けば、アクティブにしたり選択したりする必要はないです。
また、提示されたコードは投稿時に何らかのトラブルがあったようで「,(カンマ)」が「 （タブ）」になっているようです。
このほか私見ですが、ピボットテーブルをイチから作成するのをマクロで操作するのは、出来ないとは言いませんがちゃんと理解できてないとなかなかしんどいと思います。
http://officetanaka.net/excel/vba/tips/tips156.htm
なので考え方を変えて、フィールドの設定や列幅なんかを手動で設定したひな形シートを作成しておき、そのシートをコピー挿入して、データソースの変更だけしてみてはどうでしょうか？
Sub さんぷる()
Dim データ範囲 As String
With Workbooks("得意先２店別データ.xlsx")
'▼データ範囲をシート名を含めて文字列で取得する
データ範囲 = Split(.Worksheets("得意先２店別データ").Range("A1").CurrentRegion.Address(External:=True), "]")(1)
'▼ひな形シートをコピーする
Worksheets("ひな形").Copy After:=.Worksheets(.Worksheets.Count)
With .Worksheets(.Worksheets.Count)
'▼（コピーしてできたシートの１番目のピボットテーブルの）データソースを変更
.PivotTables(1).ChangePivotCache _
Workbooks(.Parent.Name).PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=データ範囲)
'▼シート名の変更
.Name = "商品サマリ"
End With
End With
End Sub
（もこな２） 2020/03/21(土) 15:24
＞◆受注リストに記載の得意先CD別・仕入先CD別にデータを分解し、シート名を「受注商品一覧」とする。 > （得意先CD：I列、仕入先CD：Y列）
１）I列とか、Y列とは？
２）得意先CDと仕入先CDのリスト（重複なし）を作成すればよいだけでは？
よくわかっていませんが、フイルタオプションが使えると思います。
で、ピボットは、意先CDと仕入先CDを、ページフィールドに配置するとよいです。
（マナ） 2020/03/21(土) 15:46
１）作業用シート作成
２）１）に、フィルタオプションで、＜受注リスト＞から、得意先と仕入先のリスト作成
３）１）に、＜受注リスト＞から、ピボット作成
４）新規ブック作成。シート名は、「商品サマリ」
５）ピボットを得意先、仕入先で抽出し、結果を４）に転記
６）見出し修正
７）名前をつけて保存
８）ピボットを別の得意先、仕入先で抽出、結果を４）に転記
９）見出し修正
10）名前をつけて保存
こんな感じで、繰り返し
最後に、１）の作業用シートを削除
「商品サマリ」の他に、「受注商品一覧」シートが必要なら
それも、＜受注リスト＞から、フィルタオプションで作成します。
（マナ） 2020/03/21(土) 16:20
隠居じーさん様 すみません、修正有難うございます。。。
質問したにも関わらず、汚い表になってしまい申し訳ありません。
このような綺麗な表にするには、どのようにされていますか？
横幅の文字数が限られているようなので、何度作成しても綺麗な表になりませんでした…。
よければ、今後の参考に教えてください。
（ピノ） 2020/03/22(日) 23:15
フィルターオプションという機能、恥ずかしながら知りませんでした。。
とても便利な機能ですね…！
図々しく大変申し訳ありませんが、
ご教授いただいた以下部分の構成が想像がついておらず、
参考の構文をいただけないでしょうか。
２）１）に、フィルタオプションで、＜受注リスト＞から、得意先と仕入先のリスト作成
３）１）に、＜受注リスト＞から、ピボット作成
申し訳ありませんが、もしも可能でしたらよろしくお願いいたします。
（ピノ） 2020/03/22(日) 23:27
隠居じーさん様
ご教授有難うございます！！！
すごい！！！できました！！！！
作成頂いたmomo様、そしてご教授いただいた隠居じーさん様に感謝です。
今後活用させていただきます。有難うございます。
（TEST）
|[A]|[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K]
[1] | |A列 |B列 |C列 |D列 |E列 |F列 |F列 |G列 |H列 |I列
[2] | 1|計上年月|ｸﾞﾙｰﾌﾟCD|ｸﾞﾙｰﾌﾟ名 |TCD |T名 |担当者CD|担当者名|管理CD |管理名|商品
[3] | 2| 202002| 111|第一ｸﾞﾙｰﾌﾟ|11101|第一ＧAＵ | 4|田中 |1111111|A社 |あ
[4] | 3| 202002| 111|第一ｸﾞﾙｰﾌﾟ|11101|第一ＧAＵ | 4|田中 |1111111|A社 |い
（ピノ） 2020/03/22(日) 23:35
Option Explicit
Sub test()
Dim tbl As Range
Dim ws As Worksheet
Dim c As Range
Dim pvt As PivotTable
Dim pvf As PivotField
Dim 行, 抽出条件, 集計 As String
Dim wb As Workbook
Dim 条件リスト
Dim 日付 As String
Dim p As String
Dim k As Long
Dim 得意先 As String, 仕入先 As String
行 = Array("出荷日", "商品コード", "商品名カナ", "ケース入数", "ボール入数")
抽出条件 = Array("管理CD", "TCD")
集計 = "引当数個数"
Set tbl = Worksheets("受注リスト").Range("A1").CurrentRegion
Set ws = Worksheets.Add
Set c = ws.Range("A1:B1")
c.Value = 抽出条件
tbl.AdvancedFilter xlFilterCopy, , c, True
条件リスト = c.CurrentRegion.Value
Set c = ws.Range("E1")
Set pvt = ws.Parent.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable(c)
pvt.RowAxisLayout xlTabularRow
pvt.ColumnGrand = False
For Each pvf In pvt.PivotFields
pvf.Subtotals(1) = False
Next
pvt.AddFields RowFields:=行, PageFields:=抽出条件
pvt.AddDataField Field:=pvt.PivotFields(集計), Function:=xlSum
Set wb = Workbooks.Add(xlWBATWorksheet)
wb.Sheets(1).Name = "商品サマリ"
日付 = Format(Date, "yyyymmdd")
' p = ThisWorkbook.Path & "\" & 日付 & "_"
For k = 2 To UBound(条件リスト)
得意先 = 条件リスト(k, 1)
仕入先 = 条件リスト(k, 2)
pvt.PivotFields(条件リスト(1, 1)).CurrentPage = 得意先
pvt.PivotFields(条件リスト(1, 2)).CurrentPage = 仕入先
pvt.TableRange2.EntireColumn.AutoFit
pvt.TableRange2.Copy
wb.Sheets(1).Range("a1").PasteSpecial xlPasteValues
wb.Sheets(1).Range("a1").PasteSpecial xlPasteColumnWidths
wb.SaveAs p & 得意先 & "_" & 仕入先 & ".xlsx", xlOpenXMLWorkbook
wb.Sheets(1).UsedRange.Clear
Next
wb.Close False
' On Error Resume Next
' ws.Delete
' On Error GoTo 0
End Sub
（マナ） 2020/03/23(月) 20:12
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
でした。
（マナ） 2020/03/23(月) 20:19
先程は失礼いたしました。
先程質問させていただいた内容は、この質問内容の続きでした。
頂いた骨子を走らせ、大枠やりたいことができました！
追加で質問、申し訳ありません。
下記の部分の行=Array～を、条件を本番用に変えてみたところ、
「pvt.AddFields RowFields:=行, PageFields:=抽出条件」この部分で、
『pivottableクラスのAddFields メソッドが失敗しました』と出てきてしまいます。
このエラーの原因がどこにあるか、行や抽出条件をいじってみてもわからず、
もしわかれば教えて頂けないでしょうか。
＜変更構文＞
行 = Array("出荷日", "専伝ＮＯ", "管理CD", "得意先店舗コード", "得意先コード", "得意先名カナ", "物流センタコード", "商品コード", "商品名カナ", "ケース入数", "ボール入数", "引当数個数", "TCD", "相手商品コード")
抽出条件 = Array("管理CD", "TCD")
集計 = "引当数個数"
※上記以外は頂いた構文をいじっておりません。
（PINO） 2020/04/12(日) 01:10
フィルター（抽出条件）と行に、同じフィールドを配置できません。
ということが原因だと思います。
必要なら、マクロの最初で、元データにフィールドを複製（別のフィールド名）すればよいです。
（マナ） 2020/04/12(日) 09:49
フィルターと行に同じフィールドの配置をやめてみましたが、
やはり同じ部分でエラーとなってしまいます。。
他に考えられる原因はありますでしょうか。
＜変更内容＞
行 = Array("出荷日", "専伝ＮＯ", "得意先店舗コード", "得意先コード", "得意先名カナ", "物流センタコード", "商品コード", "商品名カナ", "ケース入数", "ボール入数", "引当数個数", "相手商品コード")
抽出条件 = Array("管理CD", "TCD")
（ピノ） 2020/04/13(月) 11:42
以下でエラーがでないなら、その可能性が高いです。
Option Explicit
Sub test2()
Dim tbl As Range
Dim pvt As PivotTable
Dim 行, 抽出条件, 集計 As String
Dim k As Long
抽出条件 = Array("管理CD", "TCD")
集計 = "引当数個数"
Set tbl = Worksheets("受注リスト").Range("A1").CurrentRegion
行 = Application.Index(tbl.Value, 1)
For k = 0 To UBound(抽出条件)
行 = Filter(行, 抽出条件(k), False)
Next
Set pvt = ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable("")
pvt.AddFields RowFields:=行, PageFields:=抽出条件
pvt.AddDataField Field:=pvt.PivotFields(集計), Function:=xlSum
End Sub
（マナ） 2020/04/13(月) 19:05
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.