エクセル マクロ 検索 シート作成

質問

Excellマクロで検索とシート作成等を行いたいのですが、全くの素人のためご教授願えればと思います。

具体例として、範囲A-Z列まで約2000行のデータが存在します。
(1)Z列のセルの値に着目し、セルの値と同じ名前のシートが存在するか確認する。
(2)セルの値と同じ名前のシートが存在しない場合、セルの値と同じ名前のシートを作成する。（既に存在する場合は作成しない）
(3)範囲A-Z列の行データをセルの値と同じ名前のシートに追加する
以上の(1)(2)(3)の作業を1-2000行で繰り返すようにしたいです。
解りやすくご説明いただけると幸いです。宜しくお願いいたします。

回答No.5

n-jun · ベストアンサー

＃３です。

Sub　try()
　Dim　ws_m　As　Worksheet
　Dim　ws_s　As　Worksheet
　Dim　r　As　Range
　Dim　rr　As　Range
　Dim　rs　As　Range

　Application.ScreenUpdating　=　False

　Set　ws_m　=　Worksheets("Sheet1")　'データが入っているシート

　With　ws_m　'データシートのＺ１～Ｚの最終行まで
　　　　　　Set　r　=　.Range(.Range("Z1"),　.Cells(Rows.Count,　"z").End(xlUp))
　End　With

　For　Each　rr　In　r
　　　　　On　Error　Resume　Next
　　　　　　　　Set　ws_s　=　Worksheets(CStr(rr.Value))
　　　　　On　Error　GoTo　0

　　　　　If　ws_s　Is　Nothing　Then
　　　　　　　　Worksheets.Add　After:=Worksheets(Worksheets.Count)
　　　　　　　　Set　ws_s　=　ActiveSheet
　　　　　　　　ws_s.Name　=　CStr(rr.Value)
　　　　　　End　If

　　　　　　If　ws_s.Range("A1").Value　=　""　Then
　　　　　　　　　Set　rs　=　ws_s.Range("A1")
　　　　　　Else
　　　　　　　　　Set　rs　=　ws_s.Cells(Rows.Count,　1).End(xlUp).Offset(1)
　　　　　　End　If

　　　　　　rs.Resize(,　26).Value　=　rr.Offset(,　-25).Resize(,　26).Value
　　　　　　Set　ws_s　=　Nothing
　Next

　Application.ScreenUpdating　=　True
　Set　ws_m　=　Nothing
　Set　ws_s　=　Nothing
　Set　r　=　Nothing
　Set　rs　=　Nothing
End　Sub

一例です。
ご参考になれば。

お礼

回答ありがとうございます。
本マクロを試して見た結果、思い通りの処理が行えました。
ありがとうございました。

また、助言・回答等でご協力いただいた皆様に
感謝いたします。ありがとうございました。

回答No.4

kmetu

No2です
ちょっと訂正です。

Sub test()

Dim W_count As Integer, i As Integer, j As Integer
Dim Check As Boolean

W_count = Worksheets.Count

For i = 1 To Range("Z65536").End(xlUp).Row
Check = False
For j = 1 To W_count
If Worksheets(j).Name = CStr(Range("Z" & i).Value) Then
Check = True
Exit For
End If
Next j
If Check = False Then
Sheets.Add.Name = Range("Z" & i).Value
Sheets("Sheet1").Range("a" & i & ":z" & i).Copy
Sheets(CStr(Range("Z" & i).Value)).Select
ActiveSheet.Paste
End If
Next i

End Sub

お礼

返事が遅くなり、すいませんでした。

本マクロはD列のセルの値をシート名にしていた箇所を
Z列のセルの値をシート名にするよう、変更したと見受けられます。

本マクロを実行したところ、以下のエラーが発生しました。

実行時エラー”１００４”
アプリケーション定義またはオブジェクト定義のエラー
エラー箇所　：　Sheets.Add.Name = Range("Z" & i).Value

以前、回答していただいたマクロと同様のエラーが
発生してしまいました。

このエラーは以前のマクロと同様なエラーであると
考えられますが、具体的な解決方法が思い浮かびません。
せっかく回答していただけたのに、申し訳ありません

回答No.3

n-jun

２０００行のデータをＺ列の値を基にその値名のシート、または新規シートを作成し
その値名をシート名として、該当するシートに振り分けてデータを積み重ねるのかな？

問題は２０００行の値が重複しているのか？いないのか？かも。

お礼

返事が遅くなり、すいませんでした。

＞２０００行のデータをＺ列の値を基にその値名のシート、または新規シートを作成し、その値名をシート名として、該当するシートに振り分けてデータを積み重ねるのかな？
→
行データが入っているシートと同一ブック内に
Z列の値を基に、新規シート作成と該当するシートに振り分けてデータを積み重ねていく処理がしたいと思っております。

＞問題は２０００行の値が重複しているのか？いないのか？かも。
→
Z列の値において、重複しているものもあります。
Z列の値の種類として、２０個程度あります。

回答No.2

kmetu

Sub test()

Dim W_count As Integer, i As Integer, j As Integer
Dim Check As Boolean

W_count = Worksheets.Count

For i = 1 To Range("D65535").End(xlUp).Row
Check = False
For j = 1 To W_count
If Worksheets(j).Name = Range("D" & i).Value Then
Check = True
Exit For
End If
Next j
If Check = False Then
Sheets.Add.Name = Range("D" & i).Value
Sheets("Sheet1").Range("a1:z1").Copy
Sheets(Range("D" & i).Value).Select
ActiveSheet.Paste
End If
Next i

End Sub

でいかがでしょう

お礼

回答が遅くなり、すいませんでした。
本マクロを実行してみたところ、以下のエラーが発生しました。

実行時エラー”１００４”
アプリケーション定義またはオブジェクト定義のエラー
エラー箇所　：　Sheets.Add.Name = Range("D" & i).Value

マクロ実行後では、セルの値を名前にしたシートが
1つだけ作成されていましたが、シート内に行データは
入力されていませんでした。

推測として、D列のセルの値が名前であるシートを
複数回作成しているから、エラーが発生するんではないかと
思っていますが、実際はどうなんでしょうか？

回答No.1

a987654

常識的に考えての質問にした方が良いかと思います。
この質問では最大２０００シートの表ができることに
なりますが、それが可能か否かを考えて最大数の制限を
すべきと思います。

参考までにエクセル仕様についてはこちら
http://www.relief.jp/itnote/archives/000579.php

お礼

貴重な助言ありがとうございます。
現在考えられるシート作成数はおよそ２０くらいだと思いますので
上限を３０に設定したほうがよさそうです。