[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『元シートをグループ毎に分割する際、テンプレートを使用したい』(お母さん)
過去ログを参考に元シートをグループ毎にシート分割することはできたのですが、テンプレートに当てはめることがどうしてもできません。何分初心者のため、どこをどう修正していいのかわからず・・・。何かヒントでも結構ですので、教えていただけるとありがたいです。
参考にしたログは、〔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.