[[20200320225733]] 『VBAデータに該当得意先があったら、以下処理を行ax(ピノ) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBAデータに該当得意先があったら、以下処理を行いたい』(ピノ)

VBA初心者です。
いつも参考にさせていただいております。

マクロを動かした時間に受注データにある得意先のみに、
以下処理を行いたいです。
構文構成が思いつかず、ヒントをいただきたいです。

<条件>
・得意先により受注時間が異なるため、
 マクロを動かした時間に、受注データに存在する得意先のみに以下処理を実施。

・得意先は、マスタファイル.xlsmに記載の得意先以外は存在しません。
 ただ今後得意先が増える可能性があるので、マスタファイルに追記すれば追加で処理できるようにしたいです。

<マスタファイル.xlsm>
A B C D E F

	得意先コード	得意先名	仕入先CD	仕入先名	得意先店舗CD桁数
1	1	得意先1	 111111	A社	0000
2	1	得意先1	222222	B社	0000
3	2	得意先2	111111	A社	000
4	2	得意先2	222222	B社	000
5	2	得意先2	333333	C社	000
6	3	得意先3	111111	A社	00000

<受注リスト>
1 A B C D E F H I J K L
2 出荷日  専伝NO   得意先店舗コード 得意先名カナ          物流センタコード 商品コード 商品名カナ          ケース入数 ボール入数 引当数個数 相手商品コード
3 20200302 882476786 0700 得意先1フジテン 000002 225675 りんご 1 0 1 0900000
4 20200302 882476786 1311 得意先1ブンジテン 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("得意先2店別データ.xlsx").Activate		
    Range("A1").Select		

 '変数宣言(1行列目の最終行列取得)		
    LR = Cells(Rows.Count	 1).End(xlUp).Row	
    LC = Cells(1	 Columns.Count).End(xlToLeft).Column	

   Sheets.Add		

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase	 SourceData:= _	
        "得意先2店別データ!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("得意先2店別データ.xlsx").Activate		
    ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("出荷日 ").Subtotals = Array( _		
        False	 False	 False
    ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("専伝NO  ").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|仕入先名|得意先店舗CD桁数
 [2]|           1|得意先1|    111111|A社     |            0000
 [3]|           1|得意先1|    222222|B社     |            0000
 [4]|           2|得意先2|    111111|A社     |             000
 [5]|           2|得意先2|    222222|B社     |             000
 [6]|           2|得意先2|    333333|C社     |             000
 [7]|           3|得意先3|    111111|A社     |           00000

 受注リスト.xlsx Sheet1 想像図
    |[A]     |[B]         |[C]             |[D]            |[E]             |[F]       |[G]       |[H]       |[I]       |[J]       |[K]           
 [1]|出荷日 |専伝NO  |得意先店舗コード|得意先名カナ   |物流センタコード|商品コード|商品名カナ|ケース入数|ボール入数|引当数個数|相手商品コード
 [2]|20200302|   882476786|             700|得意先1フジテン  |               2|    225675|りんご    |         1|         0|         1|        900000
 [3]|20200302|   882476786|            1311|得意先1ブンジテン|               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("得意先2店別データ.xlsx")
            '▼データ範囲をシート名を含めて文字列で取得する
            データ範囲 = Split(.Worksheets("得意先2店別データ").Range("A1").CurrentRegion.Address(External:=True), "]")(1)

            '▼ひな形シートをコピーする
            Worksheets("ひな形").Copy After:=.Worksheets(.Worksheets.Count)

            With .Worksheets(.Worksheets.Count)

                '▼(コピーしてできたシートの1番目のピボットテーブルの)データソースを変更
                .PivotTables(1).ChangePivotCache _
                Workbooks(.Parent.Name).PivotCaches.Create( _
                    SourceType:=xlDatabase, _
                    SourceData:=データ範囲)

                '▼シート名の変更
                .Name = "商品サマリ"
            End With
        End With
    End Sub

(もこな2) 2020/03/21(土) 15:24


ここの意味がわかりません。

 >◆受注リストに記載の得意先CD別・仕入先CD別にデータを分解し、シート名を「受注商品一覧」とする。
 > (得意先CD:I列、仕入先CD:Y列)

1)I列とか、Y列とは?
2)得意先CDと仕入先CDのリスト(重複なし)を作成すればよいだけでは?

よくわかっていませんが、フイルタオプションが使えると思います。
で、ピボットは、意先CDと仕入先CDを、ページフィールドに配置するとよいです。

(マナ) 2020/03/21(土) 15:46


フイルタオプションを使うというのは、こんな手順です。

1)作業用シート作成
2)1)に、フィルタオプションで、<受注リスト>から、得意先と仕入先のリスト作成
3)1)に、<受注リスト>から、ピボット作成
4)新規ブック作成。シート名は、「商品サマリ」
5)ピボットを得意先、仕入先で抽出し、結果を4)に転記
6)見出し修正
7)名前をつけて保存
8)ピボットを別の得意先、仕入先で抽出、結果を4)に転記
9)見出し修正
10)名前をつけて保存

こんな感じで、繰り返し
最後に、1)の作業用シートを削除

「商品サマリ」の他に、「受注商品一覧」シートが必要なら
それも、<受注リスト>から、フィルタオプションで作成します。

(マナ) 2020/03/21(土) 16:20


隠居じーさん様 すみません、修正有難うございます。。。
質問したにも関わらず、汚い表になってしまい申し訳ありません。
このような綺麗な表にするには、どのようにされていますか?
横幅の文字数が限られているようなので、何度作成しても綺麗な表になりませんでした…。
よければ、今後の参考に教えてください。
(ピノ) 2020/03/22(日) 23:15

もこな2様
ご教授いただき、ありがとうございます。
ピボットは1からだと難易度高いんですね…
記録で出来たので、できるものかと勝手に思ってしまっていました…
考えを転換して、データソース更新でやってみたいと思います。
参考構文も有難うございます。助かります。
(ピノ) 2020/03/22(日) 23:17

こんばんは ^^
[[20110209184943]]
↑ の 方がご提供して下さっているコードをそのまま
使わせて戴いています。とても便利ですよ。。。m(_ _)m
(隠居じーさん) 2020/03/22(日) 23:20

マナ様
ご教授いただき、ありがとうございます。
1)I列とか、Y列とは?
…すみません、文字数の関係で表に記載しきれず、肝心なI列・Y列が記載できておりませんでした。説明不足で申し訳ありません。にも関わらず、解読いただき、アドバイス、ありがとうございます。

フィルターオプションという機能、恥ずかしながら知りませんでした。。
とても便利な機能ですね…!

図々しく大変申し訳ありませんが、
ご教授いただいた以下部分の構成が想像がついておらず、
参考の構文をいただけないでしょうか。

2)1)に、フィルタオプションで、<受注リスト>から、得意先と仕入先のリスト作成
3)1)に、<受注リスト>から、ピボット作成

申し訳ありませんが、もしも可能でしたらよろしくお願いいたします。

(ピノ) 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|第一GAU |       4|田中    |1111111|A社   |あ  
 [4] |  3|  202002|     111|第一グループ|11101|第一GAU |       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


マナ様
ご丁寧にありがとうございます。
いただいた骨子を参考に、作成してみたいと思います。
本当に、助かりました。。
有難うございました!!
(ピノ) 2020/03/23(月) 23:17

マナ様

先程は失礼いたしました。
先程質問させていただいた内容は、この質問内容の続きでした。

頂いた骨子を走らせ、大枠やりたいことができました!
追加で質問、申し訳ありません。
下記の部分の行=Array〜を、条件を本番用に変えてみたところ、

「pvt.AddFields RowFields:=行, PageFields:=抽出条件」この部分で、
『pivottableクラスのAddFields メソッドが失敗しました』と出てきてしまいます。

このエラーの原因がどこにあるか、行や抽出条件をいじってみてもわからず、
もしわかれば教えて頂けないでしょうか。

<変更構文>

     行 = Array("出荷日", "専伝NO", "管理CD", "得意先店舗コード", "得意先コード", "得意先名カナ", "物流センタコード", "商品コード", "商品名カナ", "ケース入数", "ボール入数", "引当数個数", "TCD", "相手商品コード")
    抽出条件 = Array("管理CD", "TCD")
    集計 = "引当数個数"

※上記以外は頂いた構文をいじっておりません。
(PINO) 2020/04/12(日) 01:10


>抽出条件 = Array("管理CD", "TCD")

フィルター(抽出条件)と行に、同じフィールドを配置できません。
ということが原因だと思います。

必要なら、マクロの最初で、元データにフィールドを複製(別のフィールド名)すればよいです。

(マナ) 2020/04/12(日) 09:49


マナ様
ご教授有難うございます。

フィルターと行に同じフィールドの配置をやめてみましたが、
やはり同じ部分でエラーとなってしまいます。。
他に考えられる原因はありますでしょうか。

<変更内容>

  行 = Array("出荷日", "専伝NO", "得意先店舗コード", "得意先コード", "得意先名カナ", "物流センタコード", "商品コード", "商品名カナ", "ケース入数", "ボール入数", "引当数個数",  "相手商品コード")
    抽出条件 = 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


マナ様
有難うございます。
頂いた構文ではエラーになりませんでした。
ご指摘いただいた通り、タイトル行に不要な空欄が入っており、削除したのですが、
やはり同じところでエラーになります…
ちょっと落ち着いて、後程もう少し見直してみたいと思います。
有難うございます。
(ピノ) 2020/04/14(火) 11:37

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.