分類ごとにシート分けとフォーマットへの転記

質問

１０００行ほどある表を分類ごとにシート分けしながら書類目次のフォーマットへ
転記していきたいのですがやり方が分かりません。

その１（A1から、項目が始まっています）
分類　　帳票名　　作成日　　サブタイトル

その２（A4セルから、項目は、始まっています）
番号　　日付（作成日）　内容（サブタイトル）

分類は、１５項目程あります。
それを、それぞれ分類ごとにわけて目次フォーマットへ
転記していきたいです。

本日までの、業務で本日中の提出期限なのですがマクロ等でやりたいのですが
やり方が分かりません。
手作業でも、他の業務をこなしながらのため終わりそうもありません。
マクロは、最近勉強を始めました。

今年、最初で最後の質問です。

助けてください。

宜しくお願い致します。

回答No.7

mt2015

私もサンプルを……
分類別のシートは既に存在するものとしています。
ソートはせずに1行ずつ読んでは各シートに番号、作成日、サブタイトルを追記しています。
エラー処理は必要に応じて入れた方が良いと思います。

Sub Sample()
　　Application.ScreenUpdating = False　'処理を早くするおまじない
　　For nRow1 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
　　　　sShtName = Cells(nRow1, 1).Text
　　　　If sShtName <> "" Then
　　　　　　With Sheets(sShtName)
　　　　　　　　'転記先シートの行を取得
　　　　　　　　nRow2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
　　　　　　　　nNum = 1　'番号を採番
　　　　　　　　If IsNumeric(.Cells(nRow2 - 1, 1)) Then
　　　　　　　　　　nNum = .Cells(nRow2 - 1, 1) + 1
　　　　　　　　End If
　　　　　　　　.Cells(nRow2, 1) = nNum
　　　　　　　　.Cells(nRow2, 2) = Cells(nRow1, 3)
　　　　　　　　.Cells(nRow2, 3) = Cells(nRow1, 4)
　　　　　　End With
　　　　End If
　　Next nRow1
　　Application.ScreenUpdating = True
End Sub

回答No.6

imogasi

#２です。手作業を織り交ぜた回答をしたが、全部VBA処理をしたいらしいので、参考に上げる。
データソート後の「分類」の変わり目までのデータを、各分類のシート名のシートに貼りつける。分類数だけ繰り返す。１行１行を分類シートにコピペするに比べて、処理完了が早いはず。
処理している意味が判らないかもしれないが、バッチ処理の古典的なロジック（アルゴリズムに近い）ではあるが、ソート法と合わせて行うことで、将来何かと役立つだろう。
Sub test02()
Set sh2 = Worksheets("Sheet2")
sh2.AutoFilterMode = False
End Sub
’－－
Sub test03()
Set sh2 = Worksheets("Sheet2")
tl = sh2.Range("a1:F1") '項目見出し行
sh2.Select
st = 2
lr = sh2.Range("a10000").End(xlUp).Row 'データ最終行取得
MsgBox lr
m = sh2.Range("a" & st)
'---
For i = st To lr
If sh2.Range("A" & i) = m Then '直前の行と分類が変わったか
Else
'直前の行と分類が変わった
sh2.Range("a" & st & ":d" & (i - 1)).Select
sn = sh2.Range("a" & (i - 1))
'sh2.Range("a" & st & ":d" & (i - 1)).Copy Sheets(sh2.Range("a" & (i - 1))).Range("A2")
Selection.Copy Sheets(sn).Range("A2")
Sheets(sn).Range("A1:F1") = tl
st = i
End If
m = sh2.Range("A" & i)
Next i
sh2.Range("a" & st & ":d" & (i - 1)).Select
MsgBox "A"
sn = sh2.Range("a" & (i - 1))
Selection.Copy Sheets(sn).Range("A2")
Sheets(sn).Range("A1:F1") = tl
End Sub

回答No.5

mt2015

人様のコードに手を入れるのは避けたいと思いますので修正は遠慮させて頂きますが……。
コードを見るとB列の帳票名でシートを別けているようですがそれで良いのですか？
こちらで想定しているデータと実際のデータでセル位置などに差異があるように思います。

補足

すいません。

そうですね。
A列に、１列挿入して「分類」がB列になるよう動かしていました。

理想は、もとの質問の形です。
分類で、シート分けされて目次フォーマットへ転記するのが目的です。
最終的に、目次が作成したいのです。
今後、このような作業が多数出てくるのでどうにかしたい次第です。
宜しくお願い致します。

回答No.4

mt2015

ANo.1です。

・元シートの２行目以降が対象
・元シートA列のセルの値と同名のシートのB列に作成日、C列にサブタイトルを追加していく。

って事で良いですか？
で、あればマクロを組むより元シートのデータを「分類」をキーに並び替えて各シートにコピペする方が早いと思います。

補足

考えている間に、手作業で行っていることも事実なのですが
今後、またこの作業は度々行うことになります。
その時に、効率よく行うためにもマクロにしたいと思っています。
--------------------------------------------------------------------
Sub test()
Dim ws As Worksheet
Dim r As Range
Dim c As Range
Dim wb As Workbook
Set ws = ActiveSheet
Set r = ws.Range("a1").CurrentRegion
Set c = r(1).Offset(, r.Columns.Count)
r.Columns("b").AdvancedFilter xlFilterCopy, , c, True
Set wb = Workbooks.Add(xlWBATWorksheet)
Do While c.Offset(1).Value <> ""
With wb.Worksheets.Add
.Name = c.Offset(1).Value
r.AdvancedFilter xlFilterCopy, c.Resize(2), .Range("a1")
End With
c.Offset(1).Delete xlShiftUp
Loop
c.Resize(2).ClearContents
Application.DisplayAlerts = False
wb.Sheets(wb.Sheets.Count).Delete
Application.DisplayAlerts = True
End Sub
-----------------------------------------------------------------
こんなマクロを、見つけました。
実行すると分類ごとにシート分けしてくれます。
これが、目次フォーマットに合うように転記してくれるよう
コードの見直しが出来れば今後便利なのかなと思っているのですが
どこをどう、変更すれば良いか分かりませんでした。
このコードから、見直すことって可能ですか？

回答No.3

mt2015

ANo.1です。

何となくわかりましたが、例として挙げられたデータで、A1セルに入っているのは「分類」「提出」どちらですか？

A1、A4、A7、A11、……と、4つ置きのセルの値が転記するシート名かと思いましたので、例のデータも「分類」ではなく「提出」なのではと思った次第です。

また、転記するデータは、「番号」は連番、「日付」はC1、C4、C7、……の値、「内容」はD1、D4、D7、……の値と言うことで良いのでしょうか。
転記するシートは存在している前提で良いですね。

やりたいことを具体的に説明してもらえないとこちらは僅かなデータを元に処理内容を推理することになり、お互いに効率が悪いです。

お礼

返信遅くなりました。

すいません、追加で教えてください。

現段階のコードは、元データがきちんと完成してからの実行
ってことで考えているのですが時々作成してから追加・追記作業が
発生します。
その時に、追加・追記してから実行するとまた新たに頭から転記
されてしまうので追加されたとこから追加・追記っていうのが
できないでしょうか？

補足

説明下手で、申し訳ありません。
A1に、入っているのは「分類」（項目）です。
A2から、提出、報告書・・・と続きます。
（分類の中に、提出や報告書等があります。）
あと、４つ置きではなく基本的にデータは詰まっています。
すいません。書き方が悪かったです。
シートは、同時進行で作成されるのが本当は良いのですが出来ている前提でも問題ありません。
元の一覧表（その１）から目次（その２）作成出来るようにすることが目的です。

回答No.2

imogasi

こんなタイプの質問を、初心者がVBAですぐ（一晩で）できるわけがない。
ＶＢＡやエクセルを経験が少ない者が、課題を甘く見てはいけない。
だがらＶＢＡと手作業の組み合わせでやる方法を参考に、書いてみる。
私のＶＢＡなどの力不足も在りますが、小生ののＶＢＡ力を云々よりも
質問者に何とか期限内に処理できるのではないかと思って書きます。
ーーー
例データ（既存）
分類 帳票名 作成日 サブタイトル
科学 2017/10/1 ttl1
小説 2017/10/2 ttl2
脚本 2017/10/3 ttl3
数学 2017/10/4 ttl4
料理 2017/10/5 ttl5
健康 2017/10/6 ttl6
科学 2017/10/7 ttl7
小説 2017/10/8 ttl8
脚本 2017/10/9 ttl9
数学 2017/10/10 ttl10
料理 2017/10/11 ttl11
健康 2017/10/12 ttl12
科学 2017/10/13 ttl13
小説 2017/10/14 ttl14
脚本 2017/10/15 ttl15
数学 2017/10/16 ttl16
料理 2017/10/17 ttl17
健康 2017/10/18 ttl18
ーー
（手作業）分類列でデータを並べ替え
Ｓｈｅｅｔ２
分類 帳票名 作成日 サブタイトル
科学 2017/10/1 ttl1
科学 2017/10/7 ttl7
科学 2017/10/13 ttl13
脚本 2017/10/3 ttl3
脚本 2017/10/9 ttl9
脚本 2017/10/15 ttl15
健康 2017/10/6 ttl6
健康 2017/10/12 ttl12
健康 2017/10/18 ttl18
小説 2017/10/2 ttl2
小説 2017/10/8 ttl8
小説 2017/10/14 ttl14
数学 2017/10/4 ttl4
数学 2017/10/10 ttl10
数学 2017/10/16 ttl16
料理 2017/10/5 ttl5
料理 2017/10/11 ttl11
料理 2017/10/17 ttl17
ーー
（手作業）重複なしに、分類名を抜き出す
フィルタ操作で、重複するレコードは無視する、で行う。
結果
Ｇ１：Ｇ６
分類
脚本
健康
小説
数学
料理
ーー
（ＶＢＡ）分類名の数だけシートを作成し、それらのシート名を分類名にする

標準モジュールに
Sub test01()
Set sh2 = Worksheets("Sheet2")
bunnrui = sh2.Range("G10000").End(xlUp).Row
MsgBox bunnrui
For i = 2 To 10
Worksheets.Add.Name = sh2.Range("g" & i)
Next i
End Sub
ーー
Ｓｈｅｅｔ２の分類での列で、
科学、脚本、健康、・・のそれぞれのセル範囲を、目で見て、捉えて
コピーし、科学、脚本、・・の対応する名前の各シートのA１以下に
、以右の範囲に貼りつける。
（ここはＶＢＡでやりたいところだが、初心者にはむつかしいので、取り急ぎ、
このようにする。
＞分類は、１５項目程あります。
だから１５回程の（シートへのコピペの）作業だが、すぐ終わると思う。
ーー
項目の見出しなど不十分なところは手作業でおぎなう。
＝＝＝
上記が気に食わないとか、他に大切な点を漏らしているとかであれば、本件の
回答はスルーしてください。
将来手作業の全部ＶＢＡで処理できるよう勉強してください。こんなタイプの質問を、初心者がVBAですぐできるわけがない。
ＶＢＡやエクセルを経験がない者が、課題を甘く見てはいけない。
だがらＶＢＡと手作業の組み合わせでやる方法を参考に、書いてみる。
私のＶＢＡなどの力不足も在りますが、回答者のＶＢＡ力を云々よりも
質問者に何とか期限内に処理できるのではないかと思って書きます。
例データ（既存）
分類 帳票名 作成日 サブタイトル
科学 2017/10/1 ttl1
小説 2017/10/2 ttl2
脚本 2017/10/3 ttl3
数学 2017/10/4 ttl4
料理 2017/10/5 ttl5
健康 2017/10/6 ttl6
科学 2017/10/7 ttl7
小説 2017/10/8 ttl8
脚本 2017/10/9 ttl9
数学 2017/10/10 ttl10
料理 2017/10/11 ttl11
健康 2017/10/12 ttl12
科学 2017/10/13 ttl13
小説 2017/10/14 ttl14
脚本 2017/10/15 ttl15
数学 2017/10/16 ttl16
料理 2017/10/17 ttl17
健康 2017/10/18 ttl18
ーー
（手作業）分類列でデータを並べ替え
Ｓｈｅｅｔ２
分類 帳票名 作成日 サブタイトル
科学 2017/10/1 ttl1
科学 2017/10/7 ttl7
科学 2017/10/13 ttl13
脚本 2017/10/3 ttl3
脚本 2017/10/9 ttl9
脚本 2017/10/15 ttl15
健康 2017/10/6 ttl6
健康 2017/10/12 ttl12
健康 2017/10/18 ttl18
小説 2017/10/2 ttl2
小説 2017/10/8 ttl8
小説 2017/10/14 ttl14
数学 2017/10/4 ttl4
数学 2017/10/10 ttl10
数学 2017/10/16 ttl16
料理 2017/10/5 ttl5
料理 2017/10/11 ttl11
料理 2017/10/17 ttl17
ーー
（手作業）重複なしに、分類名を抜き出す
Ｇ１：Ｇ６
分類
脚本
健康
小説
数学
料理
ーー
（ＶＢＡ）分類名の数だけシートを作成し、それらのシート名を分類名にする

標準モジュールに
Sub test01()
Set sh2 = Worksheets("Sheet2")
bunnrui = sh2.Range("G10000").End(xlUp).Row
MsgBox bunnrui
For i = 2 To 10
Worksheets.Add.Name = sh2.Range("g" & i)
Next i
End Sub
ーー
Ｓｈｅｅｔ２の分類での列で、
科学、脚本、健康、・・のそれぞれのセル範囲を、目で見て、捉えて
コピーし、科学、脚本、・・の対応する名前の各シートのA１以下に
、以右の範囲に貼りつける。
（ここはＶＢＡでやりたいところだが、初心者にはむつかしいので
このようにする。
＞分類は、１５項目程あります。
だから１５回程の作業だが、すぐ終わると思う。
ーー
項目の見出し不十分なところは手作業でおぎなう。
＝＝＝
上記が気に食わないとか、他に大切な点を漏らしているとかであれば、本件の
回答はスルーしてください。
将来手作業の全部ＶＢＡで処理できるよう勉強してください。
＞フォーマットへの転記　
はフォーマットの具体的な詳細の意味が分からなかった。したがって略。

回答No.1

mt2015

Excelの話ですよね？
この内容で役に立つマクロが作れると考えている時点で、マクロだけでなくExcelについても初心者である事は解りますので手助けしたいところですが、圧倒的に情報不足でなにも出来ません。

データの例と、求める結果の例を出したうえで具体的な処理を説明してください。
でも、本日中の提出ならそんな時間もないかな。

補足

その１（A1から、項目が始まっています）
分類　　帳票名　　作成日　　サブタイトル
提出　　XX検査願　6/1　　　　XXXの作成願いについて
報告書　◎◎報告書　　　　　　◎◎試験結果報告書

　　　　　　　　　　↓

　　　　　　　　提出（分類名＝シート名）
　　　　　　　　　　　　　　　　　　会社名
工事名
番号　　日付（作成日）　内容（サブタイトル）
１　 6/1　　　　XXXの作成願いについて

と、なります。

昨日、終わることが出来なかったので本日も引き続き業務を
しています。
宜しくお願い致します。