[[20140621155632]] 『元シートをグループ毎に分割する際、テンプレート』(お母さん) >>BOT

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

 

『元シートをグループ毎に分割する際、テンプレートを使用したい』(お母さん)

過去ログを参考に元シートをグループ毎にシート分割することはできたのですが、テンプレートに当てはめることがどうしてもできません。何分初心者のため、どこをどう修正していいのかわからず・・・。何かヒントでも結構ですので、教えていただけるとありがたいです。
参考にしたログは、〔2011031184111〕の日本語コード化されているものです。
どうか、よろしくお願いします。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 参照元はこちらでしょうか。
[[20110301184111]] 『1つのシートをグループ毎に分割する際、テンプレシートを使用したい』(TRO) 

 テンプレートを読み込むのは 2010(おそらく2007以降)では WorkSheets ではダメで
 Sheets になるようですね。ちょっとハマりました。

 一応テンプレートファイルを読み込む機能をオプションとして追加してみました。

 前回のときにはコメントに日付が残らないので、いつだったか記憶にありませんが、
 久方ぶりの改訂ですね。

 '//--------------------------------------------------------
 '// 処理:データを種類ごとにシートに分類
 '//--------------------------------------------------------
 '// 処理するファイル内にマクロを置いて実行してください。
 '//--------------------------------------------------------
 Option Explicit

 '//--------------------------------------------------------
 '// ファイルに併せて設定
 '//--------------------------------------------------------
 Const データシート名 = "Data"  '--- 元データシート名
 Const 分類列 = "C"             '--- 元データの分割判定を行う列
 Const データ判定列 = "E"       '--- 各シートの最終行を判定する列
 Const コピー処理単位行数 = 1   '--- コピー行単位
 Const データ開始行 = 3         '---  各シートのデータ開始行(ヘッダ行+1)

 '//--------------------------------------------------------
 '// オプション
 '//--------------------------------------------------------

 '//-------------------------
 '// 1)処理先ファイルの指定
 '// True  ・・・ 新規ファイルで作成
 '// False ・・・ 自ブック内に作成
  Const オプション_新規ファイル作成 = False

 '//-------------------------
 '// 2)追記モードの指定
 '// 上記の 1) オプションが False のときのみ有効
 '// True  ・・・ データを追記    ★注意:2回実行すると同じものが追加されます
 '// False ・・・ データ再登録   ★注意:Master シート以外をすべて再作成します
  Const オプション_データ追記 = False

 '//-------------------------
 '// 3)テンプレートファイルの使用の指定
 '// True  ・・・ テンプレートファイルを使用。True のときは テンプレートファイルパスを指定。
 '// False ・・・ データシートをテンプレートシートとして使用
  Const テンプレートファイルを使用 = True
  Const テンプレートファイルパス = "D:\Data\テンプレート.xltx"

 '//--------------------------------------------------------
 Const 作業シート名 = "TMP"      '--- 作業用テンプレートシート名

 '//--------------------------------------------------------
 '// ★アクティブなシートを処理する場合はこちらを実行
 '//--------------------------------------------------------
 Sub データをシートに分類処理_アクティブWBを処理()
 '//--------------------------------------------------------
    Dim データWB As Workbook
    Dim データWS As Worksheet

    Set データWB = ActiveWorkbook
    Set データWS = ActiveSheet

    データをシートに分類処理 データWB, データWS
 End Sub

 '//--------------------------------------------------------
 '// ★自ブックの定義で規定したシートを処理する場合はこっちを実行(従来版の動作)
 '//--------------------------------------------------------
 Sub データをシートに分類処理_自ブックを処理()
 '//--------------------------------------------------------
    Dim データWB As Workbook
    Dim データWS As Worksheet

    Set データWB = ThisWorkbook
    Set データWS = ThisWorkbook.Worksheets(データシート名)

    データをシートに分類処理 データWB, データWS
 End Sub

 '//--------------------------------------------------------
 Sub データをシートに分類処理(データWB As Workbook, データWS As Worksheet)
 '//--------------------------------------------------------
    Dim 最終行 As Long
    Dim 出力WB As Workbook
    Dim 処理WS As Worksheet
    '//--- 開始処理
    Application.ScreenUpdating = False

    With データWS
        最終行 = .Cells(Rows.Count, 分類列).End(xlUp).Row
        If オプション_新規ファイル作成 = True Then
            .Copy
            Set 出力WB = ActiveWorkbook
            出力WB.Worksheets(データWS.Name).Name = 作業シート名
            出力WB.Worksheets(作業シート名).Rows(データ開始行 & ":" & Rows.Count).Clear
        Else
            If オプション_データ追記 = False Then
                If MsgBox(データWS.Name & "以外を再作成します。よろしいですか?", vbYesNo) = vbNo Then
                    Exit Sub
                End If
                Application.DisplayAlerts = False
                For Each 処理WS In データWB.Worksheets
                    If 処理WS.Name <> データWS.Name Then
                        処理WS.Delete
                    End If
                Next
                Application.DisplayAlerts = True
            End If

            Set 出力WB = データWB
            If テンプレートファイルを使用 = False Then
                .Copy after:=データWB.Worksheets(1)
                出力WB.Worksheets(2).Name = 作業シート名
                出力WB.Worksheets(作業シート名).Rows(データ開始行 & ":" & Rows.Count).Clear
            End If
        End If

     Dim 処理行 As Long
        For 処理行 = データ開始行 To 最終行
            If .Cells(処理行, 分類列).Value <> "" Then
                行追加処理 出力WB, データWS, 処理行, .Cells(処理行, 分類列).Value
            End If
        Next
    End With

    '//--- 終了処理
    If テンプレートファイルを使用 = False Then
        Application.DisplayAlerts = False
        出力WB.Worksheets(作業シート名).Delete
        Application.DisplayAlerts = True
    End If
    Application.ScreenUpdating = True

    '//--- 表示位置の調整
    シート並べ替え処理 出力WB
    For Each 処理WS In 出力WB.Worksheets
         Application.Goto Reference:=処理WS.Range("A1"), Scroll:=True
    Next
    出力WB.Worksheets(1).Activate
    Application.CutCopyMode = False
 End Sub

 '//--------------------------------------------------------
 Private Sub 行追加処理(出力WB As Workbook, データWS As Worksheet, 対象行 As Long, シート名 As String)
 '//--------------------------------------------------------
 ' コピー先シートにデータをコピー
 '---------------------------------
    Dim 最終行 As Long

    シート確認作成処理 出力WB, シート名
    最終行 = 出力WB.Worksheets(シート名).Range(データ判定列 & Rows.Count).End(xlUp).Row + 1
    データWS.Rows(対象行 & ":" & 対象行 + コピー処理単位行数 - 1).Copy
    出力WB.Worksheets(シート名).Rows(最終行).Insert Shift:=xlDown
 End Sub

 '//--------------------------------------------------------
 Private Sub シート確認作成処理(出力WB As Workbook, シート名 As String)
 '//--------------------------------------------------------
 ' コピー先シートがあるかチェックしなければ作成
 '---------------------------------
    Dim 作業WS As Worksheet
    On Error Resume Next
    Set 作業WS = 出力WB.Worksheets(シート名)
    On Error GoTo 0

    If 作業WS Is Nothing Then
        If テンプレートファイルを使用 = True Then
            出力WB.Sheets.Add after:=出力WB.Sheets(出力WB.Sheets.Count), Type:=テンプレートファイルパス
        Else
            出力WB.Worksheets(作業シート名).Copy after:=出力WB.Worksheets(出力WB.Worksheets.Count)
        End If
        出力WB.Worksheets(出力WB.Worksheets.Count).Name = シート名
    End If
 End Sub

 '//--------------------------------------------------------
 ' シートを名前順でソート
 '---------------------------------
 Private Sub シート並べ替え処理(出力WB As Workbook)
    Dim シート開始位置 As Long

    If オプション_新規ファイル作成 = True Then
        シート開始位置 = 1
    Else
        シート開始位置 = 2
    End If

    Dim i As Long
    Dim j As Long
    For i = シート開始位置 To 出力WB.Worksheets.Count - 1
        For j = i + 1 To 出力WB.Worksheets.Count
            If StrComp(出力WB.Worksheets(i).Name, 出力WB.Worksheets(j).Name) > 0 Then
                出力WB.Worksheets(j).Move before:=出力WB.Worksheets(i)
            End If
        Next
    Next
 End Sub
(Mook) 2014/06/21(土) 19:56

ご回答ありがとうございます。
教えていただいたコードを元に実行してみたのですが、グループごとにシートわけはできるのですが、テンプレートにあてはめることはできませんでした・・・。
私のつくったファイルでは、元データが入った”データ”というシートの次に”雛形”という名前のテンプレートシートを作っております。マクロを実行すると”雛形”シートも消えてしまうので、もしかしたらテンプレートファイルを別でつくらないといけないのかなと思ったのですが、どうでしょうか?
とても、初歩的な質問で申し訳ないですが、教えていただけると幸いです。
よろしくお願いします。

(お母さん) 2014/06/25(水) 16:50


 >テンプレートに当てはめることがどうしてもできません。
 というのは何をイメージしていたでしょうか。

 前回の質問では、テンプレートファイルを使用したいという質問だったので、てっきり
 それができないということを言っていたかと思ったのですが、違うでしょうか。

 >元データが入った”データ”というシートの次に”雛形”という名前のテンプレートシートを作っております。
 という構造だと、そのシートは消えてしまうと思います。

 もしファイル内にテンプレートシートを置いてそれを展開したいということであれば、
 ちょっとまた別オプションですね。

 基本的には元データシートの行をコピーするので、同じ列構成で無いとダメだと思うの
 ですが、その点は大丈夫でしょうか。

 現在のコードで実装するのであれば、今の雛形シートを xltx で保存し、パスを記載
 すればできるかと思います(シートが増える場合はこの方が安定して動きます)。
 保存方法はこちらを参照ください。
http://softoffice-excel.com/ouyou/excel100.html

 保存先は既定のフォルダになってしまうので、場所を調べるか、自分のわかる場所に
 変更して保存してください。

 雛形シートを定義できるようにするのは、コードの変更が必要になりますので、
 これが必要な場合は別途コメントください。
(Mook) 2014/06/25(水) 18:14

できました!
丁寧におしえていただきありがとうございました。
マクロが動いたときは、感動してしまいました。
また、テンプレートの意味もわからず、とてもご迷惑をおかけしてすみませんでした・・・!
今まで、元のデータをフィルタで絞って、シートにコピペしていという作業を繰り返していたので、作業効率が格段に上がると思います。
これを気にエクセルのこと、マクロのこと勉強しようと思います。

(お母さん) 2014/06/27(金) 13:41


とりあえず、復元しました。

(kazu) 2016/09/29金) 16:22


コメント返信:

[ 一覧(最新更新順) ]


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