[[20150819220426]]　『一覧表から個別帳票への書き出し』（935）　ページの最後に飛ぶ

『一覧表から個別帳票への書き出し』（935）

エクセルで作成された一覧表から、個別帳票の各項目へデータを転記し、名前を付けて保存する作業をマクロで自動化したいと考えていますが、どうすればよいのかわからず悩んでいます。どのようなマクロで可能でしょうか？

 【一覧表】
 ブック名：納入先一覧表
 シート名：納入先

 　　　A　　　　　　B　　　　　　C　　　　　　D　　　　　　E　　……　R
 1　納入先コード　納入先名　　部署名　　　郵便番号　　　　住所　　　指示
 2　1011          A社　　　　 資材部      000-0001　　　ABCSEF　　　　1　
 3　1012　　　　　B社　　　　 資材部　　　000-0002　　　ABCDER　　　　0
 4　1012　　　　　B社　　　　 設計部　　　000-0002　　　ABCDER　　　　0
 5　1012　　　　　B社　　　　 製造部　　　000-0002　　　ABCDER　　　　1
 6　1020　　　　　C社　　　　 販売部　　　001-0003　　　SDFDFD　　　　0　
 7　1020　　　　　C社　　　　 検査部　　　001-0012　　　SDFSAG　　　　1　
（3000行位までデータがあります）

 【個別帳票】
 ブック名：個別帳票
 シート1名：共通項目
 シート2名：詳細情報

 （シート1：共通項目）
  　　　A　　　　　　B　　　　　　C　　　　　　D　　　　　　E　　
  5　納入先コード
  6　納入先名　
  7

 （シート2：詳細情報）
  　　　A　　　　　　B　　　　　　C　　　　　　D　　　　　　E　　
  5　　No.　　　　　指示　　　　部署名　　　郵便番号　　　住所
  6　　1
  7　　2
  8　　3
  9　　4
 10　　5
 11　　6

 だいたいこんな感じの一覧表と帳票の内容です。

 一覧表のA2→個別帳票_共通項目シートのC5
 　　〃　B2→　　　　〃　　　　　　　 C6
 　　〃　C2→　　〃　_詳細情報シートのC6
 　  〃　D2→　　　　〃　　　　　　　 D6
 　　〃　E2→　　　　〃　　　　　　　 E6
 　　〃　F2→　　　　〃　　　　　　　 B6
　　　　　 
 このように書き出したいのですが、もし一覧表のA列（納入先コード）が同じ場合は、一つのファイルで詳細情報にデータを書き出したいです。
 例えば、上の例で言うと、一覧表の3～5行目は同じ納入先コードなので、書き出し後の帳票は以下のようにしたいです。

  （シート1：共通項目）
  　　　A　　　　　　B　　　　　　C　　　　　　D　　　　　　E　　
  5　納入先コード　　　　　　　　1012
  6　納入先名　　　　　　　　　　B社
  7　
  8　
  9　
 10　　
 11

 （シート2：詳細情報）
  　　　A　　　　　　B　　　　　　C　　　　　　D　　　　　　E　　
  5　　No.　　　　　指示　　　　部署名　　　郵便番号　　　住所
  6　　1　　　　　　 0　　　　　資材部　　　000-0002　　　ABCDER　　　　
  7　　2　　　　　　 0　　　　　設計部　　　000-0002　　　ABCDER　　　　
  8　　3　　　　　　 1　　　　　製造部　　　000-0002　　　ABCDER　　　　
  9　　4
 10　　5
 11　　6

 データ書き出し終了後は、納入先コードをブックの名前にして保存したいです。
 一覧表のデータは約3000行、書き出し後は1200位のブックに分かれる様子です。
 一度マクロを起動すれば、1200位の個別帳票ブックが出来上がるようなのが理想です。
 分かりづらいかもしれませんが、どなたかお知恵をお貸しください。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 5:57 コード一部訂正

 納入先一覧表をマクロブックとしています。この標準モジュールに以下を。
 一覧表の　T:U列を作業列として使います。
 なお、同じフォルダに "個別帳票雛形.xlsx" という名前の雛形ブックをつくっておいてください。
 雛形ブックの各シートにはタイトル項目が記入されているものとします。

 ブックが1200ぐらい出来上がる！！！！
 エクセルでの繰り返し処理内で、大量の入出力が伴われる場合、エラーになる危険性もあります。
 ちょっと心配ですねぇ。

 Sub Sample()
    Dim shL As Worksheet
    Dim wbT As Workbook
    Dim shB As Worksheet
    Dim shD As Worksheet

    Dim listR As Range

    Application.ScreenUpdating = False

    Set wbT = Workbooks.Open(ThisWorkbook.Path & "\個別帳票雛形.xlsx")
    Set shB = wbT.Sheets("共通項目")
    Set shD = wbT.Sheets("詳細情報")
    Set shL = ThisWorkbook.Sheets("納入先")
    Set listR = shL.Range("A5", shL.Range("A" & Rows.Count).End(xlUp)).Columns("A:R")
    '一意の納入先コードリストの作成(フィルター詳細設定)
    shL.Columns("T:U").Clear    '抽出条件用作業列
    listR.Columns("A:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=shL.Range("T1"), Unique:=True

    Do While shL.Range("T2") <> ""
        'フィルター詳細設定による抽出
        listR.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=shL.Range("T1:T2"), _
            CopyToRange:=shD.Range("B5:E5"), Unique:=False
        'フィル->連続データ作成による連番セット
        With shD.Range("B6", shD.Range("B" & Rows.Count).End(xlUp)).Offset(, -1)
            .Cells(1).Value = 1
            .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
        End With

        shB.Range("B5").Value = shL.Range("T2").Value   '納入先コード
        shB.Range("B6").Value = shL.Range("U2").Value   '納入先名

        Application.DisplayAlerts = False   '同名ブックがあっても無条件上書き
        wbT.SaveCopyAs ThisWorkbook.Path & "\個別帳票_" & shB.Range("B5").Value & ".xlsx"
        Application.DisplayAlerts = True

        shL.Range("T2:U2").Delete Shift:=xlUp  '次の納入先

    Loop

    wbT.Close False             '雛形ブックを保存なしで閉じる
    shL.Columns("T:U").Clear    '抽出用条件欄のクリア

    Application.ScreenUpdating = True

    MsgBox "処理が完了しました"

 End Sub

（β） 2015/08/20(木) 05:25

（β）様

 早速ありがとうございます。
 マクロ設定して確認してみます。
 取り急ぎお礼まで。

（935） 2015/08/20(木) 16:59

（β）様

 1200個ほどのファイルに書き出すことができました。
 最初、書き出したファイルを開くことができなかったのですが
 wbT.SaveCopyAs ThisWorkbook.Path & "\個別帳票_" & shB.Range("B5").Value & ".xlsx"の拡張子の部分を
 wbT.SaveCopyAs ThisWorkbook.Path & "\個別帳票_" & shB.Range("B5").Value & ".xls"
 に拡張子を変えてみたところ、エクセルで開くことができました。
 ただ、その際「実際にはその拡張子が示すファイル形式ではありません。このファイルを開く前に、ファイルが破損していないこと、信頼できる発行元からのファイルであることを確認してください。ファイルを今すぐ開きますか？」のメッセージが出ます。
 メッセージを出さずにエクセルで開くには、どうしたら良いですか？

 それと、個別帳票にデータをコピーする時に、書式はコピーせずに値だけを張り付ける
 にはどうしたら良いでしょうか？

 この2点がクリアできれば、希望通りの出来上がりになります。
 本当にありがとうございます。

（935） 2015/08/21(金) 13:33

 とりあえず拡張子の件ですが、ひな形ブックは、2007以降の環境で作成保存した xlsx ブックなんですよね？
 それなのに、xls という名前で保存するのは？？？
 このように保存してみようと思いついたポイントは？何か思い当たることがあるんですか？

 いずれにしても、なぜそうしたかというと、開けなかったからですね？
 開こうとして開けなかった、その時にでたメッセージは、どんなものでしたか？

（β） 2015/08/21(金) 14:53

 >>それと、個別帳票にデータをコピーする時に、書式はコピーせずに値だけを張り付ける

 現在のコードでは、書式のコピーはしておらず、あくまで値のみが反映されているはずです。
 書式は、ひな形ブックのままのものを使っています。ひな形ブックに書式が設定されていれば
 それが継承されます。書式なしにしたいということなら、ひな形ブックのシートの書式を消せばいいのですが？

（β） 2015/08/21(金) 14:56

 拡張子の件は、EXCEL2010で開いているので、xlsxで大丈夫なはずなんですが

「Excelでファイル'個別帳票_1169.xlsx'を開くことができません。ファイル形式または

 ファイル拡張子が正しくありません。ファイルが破損しておらず、ファイル拡張子と
 ファイル形式が一致していることを確認してください。」とメッセージが出ます。

 OKボタンを押すと、空のExcelブックが立ち上がります。
 普段使用しているのはExcel2010ですが、Excel2003もインストールしたままなのが関係しているのでしょうか？Excel2003がどうしても必要な場面もあるのでアンインストールするわけにもいかないのです。
 拡張子をxlsに変えてみようと思った理由は、特にありません。
 最初、メモ帳で開いたりしてみたのですが、文字化けした状態だったので、何の気なしに
 xlsにしてみたら、メッセージは出ますが開けた、というわけです。

 書式のコピーの件は、値だけ貼り付けるようになっているんですね。
 勉強不足で読み取れず申し訳ありません。
 ひな形ブックに書式（罫線）が入っているのですが、貼り付け後のブックでは
 貼り付けた部分のみ罫線が消えてしまっていたもので。
 この件は、自分なりに改善策を探してみようと思います。
 ありがとうございます。

 前述のメッセージが出ないようにする件のみ、もし分かれば教えてください。

（935） 2015/08/24(月) 09:24

コメント返信：

[ 一覧(最新更新順) ]

[[20150819220426]] 『一覧表から個別帳票への書き出し』（935） ページの最後に飛ぶ

[[20150819220426]]　『一覧表から個別帳票への書き出し』（935）　ページの最後に飛ぶ