Excel 抽出データを別シートに移す方法

質問

アルバイトの方の勤怠管理のためにタイムカードレコーダーを使っていて、
毎月その内容をExcelに出力しています。

A　　　B　　　　　C　　　　　　　D　　　　E　　　F　　　　G
------------------------------------------------------------
番号　氏名　　　日付　　　　　出勤　　外出　　戻り　　退勤
1　　伊藤太郎　2005/1/16　　8:55　　　　　　　　　　　16:35
1　　伊藤太郎　2005/1/17　　8:52　　　　　　　　　　　16:40
　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　・
2　　佐藤花子　2005/1/16　　9:48　　　　　　　　　　　15:07
2　　佐藤花子　2005/1/17　　9:51　　　　　　　　　　　15:10
　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　・

１つのファイルの中にすべてのアルバイトさんのデータが出力されて
いるのですが、個人毎にデータを保存しておきたいので、毎回オートフィルタで
１人ずつデータを抽出して別シートにコピーしています。しかし、アルバイト
さんの数が増えるにつれて作業量＆時間も増えてきてしまいました。
この作業をマクロやＶＢＡで自動化できれば・・・と思うのですが、何かよい
方法はありますでしょうか。

説明が足りない部分がありましたらご指摘ください。よろしくお願いいたします。

回答No.5

matsu_jun · ベストアンサー

#2のmatsu_junです。作ってみました。これ以上になるとお仕事になっちゃうから、このくらいで勘弁してね。くれぐれも、罫線も引きたいとか、一番下の行に合計を表示させたいとか言わないでね。。。
細かな検証もしてないから、変な動作をしてしまっても怒らないでね。間違った操作をすると元データが消えちゃうから、ちゃんとバックアップをとってから作業をしてね。

Sub 個人別データ作成()
'余計なシートを削除する。
i# = 1
Application.DisplayAlerts = False
Do While Worksheets.Count > 1
If Worksheets(i).Name = "元データ" Then i = 2
Worksheets(i).Delete
Loop
Application.DisplayAlerts = True

For i = 2 To Worksheets("元データ").Cells(65536, 2).End(xlUp).Row
j# = 1

'検索中の人のシートが既にできているかを判断する。
For Each sheet_name In Worksheets
If sheet_name.Name = Worksheets("元データ").Cells(i, 2).Value Then
j = 2
Exit For
End If
Next
If j = 1 Then '検索中の人のシートがない場合、新規に作成する。
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Worksheets("元データ").Cells(i, 2).Value
For j = 1 To 7
Worksheets(Worksheets.Count).Cells(1, j).Value = Worksheets("元データ").Cells(1, j).Value
Next j
Worksheets(Worksheets.Count).Columns("D:G").NumberFormatLocal = "h:mm;@"
End If

'データコピー部
For j = 7 To 1 Step -1
Worksheets(Worksheets("元データ").Cells(i, 2).Value). _
Cells(Worksheets(Worksheets("元データ").Cells(i, 2).Value). _
Cells(65536, 1).End(xlUp).Row + 1, j).Value = Worksheets("元データ").Cells(i, j).Value
Next j
Next i

'それぞれのシートの列幅を最適化します。
For Each sheet_name In Worksheets
sheet_name.Columns("A:G").AutoFit
Next
End Sub

お礼

matsui_junさん、大変お手数をおかけしてすみませんでした。
ここまでのコードを教えて頂ければもう十分です。
教えて頂いたコードを元にあとは自力で頑張りたいと思います。
本当にありがとうございました。

回答No.4

telescope

ピボットテーブルでかなり省力化できると思います。

「データ」－「ピボットテーブルとピボットグラフ　レポート」を選択します。
分析するデータのある場所に　〔Excelのリスト/データベース〕
作成するレポートの種類に　〔ピボットテーブル〕
を選び【次へ】

使用するデータの範囲を指定します。
データの範囲内にカーソルがあればExcelが自動的に範囲を表示しますが、
将来入力する分を見越して多めに指定します。
入力してあるデータの範囲が、　$A$1:$H$50　の範囲であっても、
$A$1:$H$300　のように余分に指定しておきます。
後で追加したデータもボタンを押すだけで更新されますので、そのためです。

【次へ】ボタンを押して、
新規ワークシートを選んで、【完了】ボタンを押します。

行のフィールドに　日付、出勤、外出、戻り、退勤をそれぞれドラッグします。
ページのフィールドに　氏名　をドラッグします。
データフィールドに　出勤　をドラッグします。
出勤した数が表示されます。元のデータにないものですが、これがないと表が出来ません。
出勤日数がわかりますので、使ってください。

「2005/1/16　計」、「(空白)　計」などと、それぞれの計が表示されますが、
「2005/1/16計」と書かれたセルで右クリックして、「表示しない」を選びます。
「○○　計」と書かれたセルをすべて「表示しない」にします。
日付の列の一番下に「(空白)」の行がありますので、これも「表示しない」にします。

ピボットテーブルツールバーにある「ピボットテーブル」ボタンの▼をクリックして、「ページの表示」を選びます。
ページフィールドに「氏名」が表示されていることを確認して、OKボタンを押します。
氏名ごとのシートが一気に出来上がります。

「表示しない」設定は、それぞれのページで生きています。
残念ながら、条件付き書式は、それぞれのシートで設定しなければならないようです。
元のデータの空白欄は、(空白)と表示されますが、これが邪魔でしたら、
条件付き書式で設定します。
「セルの値が」、「次の値に等しい」にして
(空白)と入力します。カッコは半角です。
書式のフォントの色を「白」にします。

(空白)というシートも作成されますが、このシートは削除します。

データを追加したときは、ピボットテーブルの表の範囲内のどれかのセルを選択した状態で、
ピボットテーブルツールバーにある赤い「！」をクリックすると更新されます。

表の見映えが、元の表と少し変わってしまいますが、省力化は出来ると思います。

お礼

ピボットテーブルを使うという手もあるんですね。
今後の参考にさせて頂きます。どうもありがとうございます。

回答No.3

chal

マクロの記録機能を使うと良いと思います。

１．全てのデータがあるシートを開いておく。
２．マクロの記憶機能を開始する。
３．ある人の名前でフィルタを掛け、別シートを作成する。
４．マクロの記憶機能を終了する。

　マクロがある程度分かる人なら、ここからEditorを開き、少しアレンジすれば必要な人数分の処理を行うことが簡単に出来ると思います。
　あまり分からないようでしたら、力技になってしまいますが、上記３を人数分繰り返せば良いかと。

お礼

そうですね。
記憶したマクロをアレンジする手もありますね。
AccessのＶＢＡならば大体のプログラミングはできるのですが、
Excelになってしまうとまだまだきちんと理解できていないので、もっと自分自身で勉強が必要です。
ご回答ありがとうございます。

回答No.2

matsu_jun

本当に必要最小限のマクロソースを以下に示しますので、あとはここからいろいろな機能を追加してみてください。
元データの入っているシート名を「元データ」に、後はアルバイトの人の名前のシートをアルバイトの人数分用意してください。sheltieさんの例であれば、「元データ」「伊藤太郎」「佐藤花子」という名前の3枚のシートを作成していただくことになります。
以下のコードを標準モジュールに貼り付けて実行してみてください。
詳しい説明は必要であればいたしますが、簡単に言えば、元データの2列目の名前を、2行目から順番に見ていき、同じ名前のシートに1行ずつ貼り付けていくという操作を、元データの最下行(入力されている中の最下行)まで繰り返すというものです。

Private Sub 個人別データ作成()
For i# = 2 To Worksheets("元データ").Cells(65536, 2).End(xlUp).Row
For j# = 7 To 1 Step -1
Worksheets(Worksheets("元データ").Cells(i, 2).Value). _
Cells(Worksheets(Worksheets("元データ").Cells(i, 2).Value). _
Cells(65536, 1).End(xlUp).Row + 1, j).Value = Worksheets("元データ").Cells(i, j).Value
Next j
Next i
End Sub

あとは、罫線が必要かどうか、再実行するときに一度シートのデータをクリアするかなど、やりたいことに応じてソースを追加していってください。
貼り付け方が分からない時はこの欄にて、補足要求をしてくださいませ。

お礼

教えて頂いたソースをモジュールに貼り付けて実行してみたところ、
うまく処理することができました！！
どうもありがとうございます(^-^)

補足

恐縮ですがさらに追加でご質問させて頂きたいのですが・・・
上記のコードの場合は、あらかじめそれぞれの個人名をつけたシートを
用意しておく必要がありますが、これを、「コードを実行する際にシートを
その人の個人名で新規作成してからデータを貼り付けていく」という処理に
することは可能でしょうか。

回答No.1

BLUEPIXY

抽出先を別シートにするには、
抽出先のシートで、データ～フィルタ～フィルタオプションの設定をします。

お礼

ご回答ありがとうございます。
「フィルタオプションの設定」を利用することも考えていたのですが、
アルバイトさんの数が４０名を超えている状態なので、なるべく一括で
自動処理できる方法がないかと思い、質問させていただきました。