こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

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

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

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

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

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

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

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

助けてください。

宜しくお願い致します。

投稿日時 - 2017-12-27 16:12:47

QNo.9412238

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.7

私もサンプルを……
分類別のシートは既に存在するものとしています。
ソートはせずに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

投稿日時 - 2017-12-29 10:06:35

ANo.6

#2です。手作業を織り交ぜた回答をしたが、全部VBA処理をしたいらしいので、参考に上げる。
データソート後の「分類」の変わり目までのデータを、各分類のシート名のシートに貼りつける。分類数だけ繰り返す。1行1行を分類シートにコピペするに比べて、処理完了が早いはず。
処理している意味が判らないかもしれないが、バッチ処理の古典的なロジック(アルゴリズムに近い)ではあるが、ソート法と合わせて行うことで、将来何かと役立つだろう。
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

投稿日時 - 2017-12-28 22:01:57

ANo.5

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

投稿日時 - 2017-12-28 17:12:37

補足

すいません。

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

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

投稿日時 - 2017-12-28 18:36:52

ANo.4

ANo.1です。

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

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

投稿日時 - 2017-12-28 11:27:26

補足

考えている間に、手作業で行っていることも事実なのですが
今後、またこの作業は度々行うことになります。
その時に、効率よく行うためにもマクロにしたいと思っています。
--------------------------------------------------------------------
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
-----------------------------------------------------------------
こんなマクロを、見つけました。
実行すると分類ごとにシート分けしてくれます。
これが、目次フォーマットに合うように転記してくれるよう
コードの見直しが出来れば今後便利なのかなと思っているのですが
どこをどう、変更すれば良いか分かりませんでした。
このコードから、見直すことって可能ですか?

投稿日時 - 2017-12-28 12:44:36

ANo.3

ANo.1です。

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

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

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

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

投稿日時 - 2017-12-28 09:14:26

補足

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

投稿日時 - 2017-12-28 10:14:02

お礼

返信遅くなりました。

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

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

投稿日時 - 2018-01-06 08:09:16

ANo.2

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

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

標準モジュールに
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
ーー
Sheet2の分類での列で、
科学、脚本、健康、・・のそれぞれのセル範囲を、目で見て、捉えて
コピーし、科学、脚本、・・の対応する名前の各シートのA1以下に
、以右の範囲に貼りつける。
(ここはVBAでやりたいところだが、初心者にはむつかしいので
このようにする。
>分類は、15項目程あります。
だから15回程の作業だが、すぐ終わると思う。
ーー
項目の見出し不十分なところは手作業でおぎなう。
===
上記が気に食わないとか、他に大切な点を漏らしているとかであれば、本件の
回答はスルーしてください。
将来手作業の全部VBAで処理できるよう勉強してください。
>フォーマットへの転記 
はフォーマットの具体的な詳細の意味が分からなかった。したがって略。

投稿日時 - 2017-12-27 21:29:10

ANo.1

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

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

投稿日時 - 2017-12-27 17:39:23

補足

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

          ↓

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

と、なります。

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

投稿日時 - 2017-12-28 08:32:54

あなたにオススメの質問