[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『一つのシートをグループ別にして複数シートに分割したい』(ロン)
いつもお世話になっています。
過去ログの [[20050721182519]]でやってみたのですが、
件数が多いせいか(今回のデータは約16500行)、処理に時間がかかっています。
今後、件数は増えていく予定です。
時間短縮することは可能でしょうか?
または、Excel2007にて作業していますが、Excel2003の時のように
ピボットテーブルからページ表示する方法はあるのでしょうか?
参考にさせていただいたVBA↓
'---------------------------------
Sub Grouping() '--------------------------------- Dim i% Dim LastR As Long
LastR = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False With Worksheets(1) For i = 2 To LastR Call AddLine(i, .Cells(i, 7).Text) '検査規格名で分割。但し、TEXTで文字を取り出す Next End With
MsgBox "処理中"
Application.ScreenUpdating = True End Sub
'--------------------------------- Sub AddLine(lineNum%, sheetName$) '--------------------------------- Dim lastLine%
Call checkAndMake(sheetName) lastLine = Worksheets(sheetName).Range("G20000").End(xlUp).Row + 1 Worksheets(1).Rows(lineNum).Copy Worksheets(sheetName).Rows(lastLine).Insert Shift:=xlDown End Sub
'--------------------------------- Sub checkAndMake(sheetName$) '--------------------------------- Dim tmpWS As Worksheet On Error Resume Next Set tmpWS = Worksheets(sheetName) If tmpWS Is Nothing Then Worksheets.Add after:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = sheetName Worksheets(1).Rows(1).Copy Worksheets(sheetName).Rows(1).Insert Shift:=xlDown End If On Error GoTo 0 End Sub
教えて下さい。
よろしくお願いいたします。
>ピボットテーブルからページ表示する方法 ピボットテーブルツール の オプションタブを開くと ピボットテーブルグループ(先頭のグループ)に オプション▼ があると思いますが これを開いて「レポート フィルタ ページの表示(P)」で良いと思います。
確認してみて下さい。
コードの方ですが、同じような質問は他にもたくさんなされているので それぞれ違ったコードが載せられていると思います。
それらを確認して、快適に動くものを探してみられるのはどうでしょう。
(HANA)
ありました!
→「レポート フィルタ ページの表示(P)」
早速やってみます。
コードももう少し研究してみます(泣)
ありがとうございました。
ロン
とりあえず、過去ログ。 全部 seiyaさんのコードですが。。。 [[20070207040844]] 『ひとつのワークシートをある条件で複数シートに分』(ごんたけ) [[20060114134347]] 『個人別に分けたい』(う) [[20051127021238]] 『シート別に小分けにしたい』(えめら) 石投げたら当たるくらいあると思うんだけどなぁ。。。 どれも6年以上前の質問だし。 探してもらうと、もっと最近のも見つかると思いますよ。
新規投稿されたスレの後始末もお忘れなく。
(HANA)
Dictionaryの方が速いと思いますが、自己啓発で作成してみました。 フィルタオプション、オートフィルタを使用しています。元表の形式はそちらで上げた過去ログのとおりとしてます。 (usamiyu) 元表(シート1) [A] [B] [C] [D] [1] 分類 品名 購入日 調理日 [2] 野菜 トマト 7/1 7/1 [3] 野菜 にんじん 7/1 7/1 [4] 野菜 にんじん 7/2 7/5 [5] 果物 みかん 7/7 7/7 [6] 果物 みかん 7/11 7/11 [7] 野菜 トマト 7/11 7/12 [8] 果物 みかん 7/15 7/18
Sub test() Dim r As Range Dim Dat As Range Dim c As Range Dim sh1 As Worksheet Dim sh2 As Worksheet Dim shNew As Worksheet Dim z As Long
Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2")
z = sh1.Range("B" & sh1.Rows.Count).End(xlUp).Row sh2.UsedRange.Clear 'フィルタオプションを使用して、B列の重複を無視してシート2のA列にコピー sh1.Range("B1:B" & z).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=sh2.Range("A1").CurrentRegion, Unique:=True 'シート2の最終行までを検索範囲とする Set r = sh2.Range("A2", sh2.Range("A" & sh2.Rows.Count).End(xlUp)) '検索するデータはシート1 Set Dat = sh1.Range("A1").CurrentRegion
For Each c In r 'オートフィルタを使用して抽出したものを新しいシートにコピー Dat.AutoFilter Field:=2, Criteria1:=c.Value Set shNew = Worksheets.Add(, Sheets(Sheets.Count)) On Error Resume Next shNew.Name = c.Value On Error GoTo 0 Dat.Copy shNew.Range("A1") Next Dat.AutoFilter End Sub
コード、ありがとうございました!
こちらのデータ条件に合わせて修正して実行したところ、
あっという間にシート分割できました。
これから内容を勉強させていただきます。
今後ともよろしくお願いします。
ロン
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.