Ｅｘｃｅｌのデータでコピペの良い方法は？

質問

出社日　帰社日 氏名　出社時間　帰社時間　仕事内容
171216　171216　伊藤　　8:00　 17:00　　　○○
171216 171216 伊藤　　空白　　 空白 △△
171218 171219　伊藤 8:00　　 10:00　　　○○
171220 171221　伊藤　　8:00 14:00　　　○○
171221 171222　伊藤 空白　　 空白　　　 ××
171225 171226　伊藤　　8:00 10:00　　　□□

このようなデータを

日付 出社時間　退社時間
171216 　8:00 17:00
171217 空白　　　空白
171218　 8:00 空白
171219　 空白　　　10:00
171220 8:00 空白
171221 空白　　　14:00

このように日付毎に出社時間、退社時間のみ抜き出して、違うシートに作成したいのですが、何か良いコピペの方法など
有りましたらお教えいただきたく、宜しくお願いします。

わかりにくい上にデータの表示が見にくくて、すいません。

回答No.14

Wendy02 · ベストアンサー

こんにちは。

＞日付　　出社時間　帰社時間　出社時間　帰社時間　…AX列まで続く
＞171216　　空白　　　　空白　　　　6.1　　　　16.35　　　　7　…

ログを通して読み直しながら、#9のコードと#13のデータを途中で正しく張り合わせれば、どう考えてみても、そのようなことになることはありえないと思っております。確か、途中まで出来ていたので、その部分の修正だけであって、並べ替えなどの機能を取り付けることだけだった、ということだったはずです。それが、なぜ、まったく表の形態が崩れてしまったのかは、こちらでは、見当がつきません。

ひとりの人が、四六時中、出と入を繰り返しているとか、元のデータに複数の人が混じっている場合は、この限りではありません。

最初に、オートフィルタで「ひとりに選定」してからでないと、時間に論理矛盾を起こしますので、現在のマクロでは、そのような集計は不可能です。「伊藤さん」なら「伊藤さん」のデータを出していただかないといけません。また、掲示板で出しているサンプルと、生データとはかなり開きがある場合も、予想外のことがあるかと思います。

現状では、複数の人を振り分けするような機能を持っておりません。つまり、転記した後の段階を知らされておりませんので、シートごとに分けるにしても、シート自体の指定は、人がするように出来ております。

（それ自体は可能なのですが、設計の段階で、もう一度、最初から積み上げないと、現在のコーディングの中で直すのは、返ってややこしくなってしまいます。）
．

お礼

いろいろとお世話になり、本当にありがとうございました。
自分でももっと勉強して、出来るだけ頑張ってみたいと思います。

回答No.13

Wendy02

----前の続きです。------
#9 の途中の
※ペースト部分から、最後まで上書きになります。

'--------------------------------------------------
'ペースト

PasteposFind:
　 Dim m As Integer
　 Dim n As Integer
　 Dim o As Integer
　 Dim buf As String
　 On Error Resume Next
　 Set PastePos = Application.InputBox("ペーストする場所の左上端を選択してください。", "データペースト", "$A$1", Type:=8)
　 On Error GoTo 0
　 If PastePos Is Nothing Then Exit Sub
　 Set PastePos = PastePos.Cells(1)
　 If PastePos.Value = "" Or PastePos.Offset(2).Value = "" Then
　　　MsgBox "表がないと貼り付けられません。"
　　　GoTo PasteposFind
　 End If
　 If PastePos.Address = r.Address And _
　 PastePos.Parent.Name = r.Parent.Name Then MsgBox "同じ場所には貼り付けることが出来ません。", 64: GoTo PasteposFind

　 Set r2 = Range(PastePos, PastePos.End(xlDown))

　 Application.Goto r2.Cells(1) '移動

　 With r2.Offset(1, 1).Resize(r2.Rows.Count - 1, r2.CurrentRegion.Columns.Count)
　　 If WorksheetFunction.CountA(.Cells) > 1 Then
　　　 If MsgBox("データのみ削除しますがよろしいですか？", vbOKCancel) = vbCancel Then Exit Sub
　　　　　.ClearContents
　　 End If
　 End With
　 Application.ScreenUpdating = False
　 For j = LBound(inData, 2) To UBound(inData, 2)
　　　On Error Resume Next
　　　mRow1 = 0
　　　mRow1 = WorksheetFunction.Match(inData(0, j), r2, 0)
　　　If mRow1 > 0 And inData(1, j) <> "" Then
　　　　 Do
　　　　 If IsEmpty(r2.Cells(mRow1, 2 + m * 2)) Then
　　　　　　r2.Cells(mRow1, 2 + m * 2).Value = inData(1, j)
　　　　　　Exit Do
　　　　 Else
　　　　　　m = m + 1
　　　　 End If
　　　　 Loop
　　　End If
　　　mRow2 = 0
　　　mRow2 = WorksheetFunction.Match(outData(0, j), r2, 0)
　　　If mRow2 > 0 And outData(1, j) <> "" Then
　　　 Do
　　　　 If IsEmpty(r2.Cells(mRow2, 3 + n * 2)) And _
　　　　　　r2.Cells(mRow2, 2 + n * 2) < CDate(outData(1, j)) Then
　　　　　　r2.Cells(mRow2, 3 + n * 2).Value = outData(1, j)
　　　　　　Exit Do
　　　　 Else
　　　　　　n = n + 1
　　　　 End If
　　　　 Loop
　　　End If
　　　On Error GoTo 0
　　　m = 0: n = 0
　 Next j
　 With PastePos
　　Range(.Offset(, 4), .Offset(, 4).End(xlToRight)).ClearContents
　 End With
　 With r2.CurrentRegion.Columns
　 If .Count > 3 Then
　　　 For o = 1 To .Count - 3
　　　　 .Cells(1, 3 + o).Value = .Cells(1, 1 + o).Value
　　　 Next
　　 End If
　 End With
　 Application.ScreenUpdating = True
　 '並べ替えのオプション

　 If MsgBox("データの並べ替えが必要ですか？", vbOKCancel) = vbOK Then
　　 Call TimeOrdering(PastePos)
　 End If
　 Set r = Nothing: Set r1 = Nothing: Set r2 = Nothing
　 Set PastePos = Nothing
End Sub
Sub TimeOrdering(TopCell As Range)
'-----------------------------------
'貼り付けシートの並べ替えのオプション
'-----------------------------------
Dim c As Range
Dim i As Integer
Dim u As Integer
Dim j As Integer
Dim t As Variant
Dim EndCol As Integer
　Application.ScreenUpdating = False
　EndCol = TopCell.CurrentRegion.Columns.Count
　For Each c In Range(TopCell, TopCell.End(xlDown))
　　If IsNumeric(c.Value2) Then
　　　　 i = 1
　　　　 u = Int((EndCol - 1) / 2)
　　　　Do While i < u
　　　　　j = u
　　　　　 Do While j > i
　　　　　 '並べ替え
　　　　　　 If c.Offset(, j * 2 - 1).Value < c.Offset(, i * 2 - 1).Value Then
　　　　　　　t = c.Offset(, j * 2 - 1).Resize(, 2).Value
　　　　　　　c.Offset(, j * 2 - 1).Resize(, 2).Value = c.Offset(, i * 2 - 1).Resize(, 2).Value
　　　　　　　c.Offset(, i * 2 - 1).Resize(, 2).Value = t
　　　　　　End If
　　　　　　j = j - 1
　　　　　 Loop
　　　　　 i = i + 1
　　　　Loop
　　End If
　Next c
　Application.ScreenUpdating = True
End Sub

補足

お礼が遅くなって申し訳ありません。
せっかく皆さんが良い回答を出してくれているのに…
事情があってパソコンをさわる時間が無く、返信が遅くなってしまいました。Wendy02さんのご厚意に感謝いたします。
このマクロを実行してみたところ、下記のようになりました。

《元のデータ》
出社日　帰社日　氏名　出社時間　帰社時間
171216　171216　伊藤　　　7.20　　　18.30
171216　171217　伊藤　　　19.16　　　10.13
171219　171219　伊藤　　　空白　　　空白
171219　171220　伊藤　　　20.30　　　15.00
171219　171219　伊藤　　　7.50　　　　16.10
171220　171220　伊藤　　　空白　　　空白　　　　　　

《マクロで振り分けたデータ》
日付　　出社時間　帰社時間　出社時間　帰社時間　…AX列まで続く
171216　　空白　　　　空白　　　　6.1　　　　16.35　　　　7　…
171217　　空白　　　　空白　　　　空白　　　　空白　　　　空白…
171218　　空白　　　　空白　　　　空白　　　　空白　　　　空白…
171219　　3　　　　　　13　　　　　4.15　　　　14.1　　　　6.4…
171220　　5　　　　　 空白　　　　　5.27　　　　8.5　　　　6.1…
171221　　3.3　　　 　空白　　　　　4.3　　　　7.1　　　　 5.55…
…
このようにずらーっと列が増えてしまい、そこにランダムに数値が並んでいます。何かやり方が悪いのでしょうか？
また、私の説明不足で申し訳ありませんが、時間データの区切りは：ではなく.でした。例（誤７：２０→正７．２０）

回答No.12

Wendy02

こんにちは。Wendy02です。

私は、4年前、日勤の配達のデータ集計表に携わったことがあります。その時は、マクロも出来ずに、私は、中途半端なことしか出来ませんでしたが、今、その時の挽回をしているような気がします。

＞　　　　　　　　　　　出社　　　帰社　　出社
＞171219　171219　伊藤　　　7:50　　　 16:10
＞171219　171220　伊藤　　　20:30　　　15:00

＞に関しましても、並び替えを行っていなかったため、確かにこのような形が正しいものです。

データの入力の際に、そういデータが発生するという意味ですよね。

今回、ペーストの部分のみの修正ですが、エラーの発生しやすいところを修正したのと、並べ替えオプションを加えました。試してみたところ、データ入力の間違いまでは、今のコードでは、検出は不可能でした。

つまり、発生する可能性として、「人の名前を間違えて振り分けした時」になります。しかし、表にした時に、おそらくは、出社時間が1つもないのに、帰社時間が二つ出てきたりします。それは、原票をチェックしたほうがよいですね。

それと、エラー検出で、そんなことはないはずですが、

オートフィルタの

　出社日　帰社日　氏名　出社時間　帰社時間

このタイトル行の1つを消去してしまうと、マクロで、
「正しく最左列を選択してください。」
として、進んでいきません。

もし、こういうミスがありえる、とすれば、

If Not (WorksheetFunction.CountA(r1.Rows(1)) = 5 And r.Cells(1).Value <> "") Then MsgBox "正しく最左列を選択してください。", 16: Exit Sub

このエラー検出コードは、ないほうがよいかもしれませんね。エラーを出して、自分でもわかりませんでしたから。余計なお世話のエラーチェックのような気がしてきました。

ここの掲示板は、しばらく開けておいて、エラーが発生するか、不明な問題点があるか、なるべく、すぐに締めないほうがよいですね。

なお、私の方は、Excelのマクロで、ここの掲示板にアクセスしていますので、こちらが気にしている限りは、「済み」になるまでは、チェックは出来ます。

このレベルになると、私も、コードだけでは自信が持てません。

次のスレッドにコードを置いておきますので、最低、2回の書き込みが出来ます。

回答No.11

imogasi

#6,#8です。
下記のように、関数を用いて、Ｓｈｅｅｔ１の１行を２行にし、出社時間と帰社時間を別行にしてみました。
この結果は使えますか。もし使えるなら、それに加えて、さらに行うべき（満たすべき条件など）、作業を補足してみてください。
たとえばこういう行は不要など。もしそういうのなら、並べ替えを行って、ある部分の行を削除すれば、達成できると思う。
例データ
Ｓｈｅｅｔ１に
171216 171216 伊藤 8:00 17:00 ○○
171216 171216 伊藤 空白 空白 △△
171218 171219 伊藤 8:00 10:00 ○○
171220 171221 伊藤 8:00 14:00 ○○
171221 171222 伊藤 空白 空白 ××
171225 171226 伊藤 8:00 10:00 □□
Ｓｈｅｅｔ２の
Ａ１に=INDEX(Sheet1!$A$1:$F$6,INT((ROW()-1)/2)+1,COLUMN())
Ｂ１に=INDEX(Sheet1!$A$1:$F$6,INT((ROW()-1)/2)+1,COLUMN())
Ｃ１に=INDEX(Sheet1!$A$1:$F$6,INT((ROW()-1)/2)+1,COLUMN())
Ｄ１に=IF(MOD(ROW(),2)=1,INDEX(Sheet1!$A$1:$F$6,INT((ROW()-1)/2)+1,COLUMN()+MOD(ROW()-1,2)),"")
Ｅ１に=IF(MOD(ROW(),2)=1,"",INDEX(Sheet1!$A$1:$F$6,INT((ROW()-1)/2)+1,COLUMN()))
Ｂ１，Ｃ１はＡ１を横方向に＋ハンドルを引っ張ればよい。
Ｄ１とＥ１に少し細工が要る。
Ａ１：Ｅ１を６＊２＝１２行下方向に式を複写する。
結果
Ｓｈｅｅｔ２に（実際やってもらえば、下記の見た目と違い、出社時間　帰社時間は別列で出ます）
171216 171216 伊藤 8:00 ○○（8:00はD列）
171216 171216 伊藤 17:00 ○○（17:00はE列）
171216 171216 伊藤 空白 △△
171216 171216 伊藤 空白 △△
171218 171219 伊藤 8:00 ○○
171218 171219 伊藤 10:00 ○○
171220 171221 伊藤 8:00 ○○
171220 171221 伊藤 14:00 ○○
171221 171222 伊藤 空白 ××
171221 171222 伊藤 空白 ××
171225 171226 伊藤 8:00 □□
171225 171226 伊藤 10:00 □□

お礼

お礼が遅くなって申し訳ありません。
せっかく皆さんが良い回答を出してくれているのに…
事情があってパソコンをさわる時間が無く、返信が遅くなってしまいました。
このような関数を使って、行をずらす事も可能なんですね！出社時間と退社時間の行がずれれば、これを加工してなんとか希望の形に近づけそうです。本当にありがとうございました。

回答No.10

Wendy02

こんばんは。

データを一目みて理解できましたが、それは、ちょっと、どう扱ってよいのか、今は、手がつけられません。もう少し、説明してくださいませんか？

以下のようなデータですと、手作業でも私はわからないのです。何か、長距離の運転手さんの出勤簿のような気がします。

《元のデータ》で、
171216　171216　伊藤　　　7:20　　　18:30
171216　171217　伊藤　　　19:16　　　10:13

このようなことは、まったく予想されていないからなのです。
同日で、帰社,出社があるというのは、予定外の内容なのです。

少なくとも、
171216
172117

という日計の区分けでは、今のままでは、確保したデータが飛んでしまいます。
それは、どのようになるのを予想されていますか？

　　　　出社　　　帰社
171216　7:20　　　18:30
171217　　　　　　10:13

このようになることでしょうか？それとも、
　　　　出社　　　帰社　　　出社
171216　7:20　　　18:30　　19:16
171217　　　　　　10:13

というようなものですか？

そうすると、おそらく、左から埋めていくような形になるかと思います。
『予想図』

　　　　　帰社　　出社　　　帰社　　　出社
171216　　　　　　7:20　　　18:30　　19:16
171217　　10:13

それから、

　　　　　　　　出社　　　帰社　　　　出社
171219　171220　伊藤　　　20:30　　　15:00
171219　171219　伊藤　　　7:50　　　　16:10

これは、たぶん、時系列で逆になるだろうから、

　　　　　　　　出社　　　帰社　　出社
171219　171219　伊藤　　　7:50　　　 16:10
171219　171220　伊藤　　　20:30　　　15:00

ということですか？

補足

何度もありがとうございます。
＞長距離の運転手さんの出勤簿のような気がします。
その通りです。ドライバーの毎日の出勤形態を記録してあるものが、ここで言う《元のデータ》ということです。（Excelに変換したもの）
途中、飛んでしまっている日付は出勤していないということ。
出勤・退社とも同じ日付がかぶっている部分は仕事内容が違うということです。
＞同日で、帰社,出社があるというのは、予定外の内容なのです。
これは、私の説明不足でした。申し訳ありません。
ドライバーなので、時間が不定期なこともあり、同日で出社が二回有るような場合もあります。
一番ベストな振り分け方はWendy02さんのおっしゃるとおり

　　　　　帰社　　出社　　　帰社　　　出社
171216　　　　　　7:20　　　18:30　　19:16
171217　　10:13

というように正確に出せればありがたいです。

それから
　　　　　　　　　　　出社　　　帰社　　出社
171219　171219　伊藤　　　7:50　　　 16:10
171219　171220　伊藤　　　20:30　　　15:00

に関しましても、並び替えを行っていなかったため、確かにこのような形が正しいものです。

回答No.9

Wendy02

こんばんは。Wendy02です。

＞マクロが理解できていないと無理なようでしたら、はっきりおっしゃっていただけたらありがたいです。

そんなことはありません。こちらが作ったマクロを貼り付けるだけですから、記録マクロでマクロを記録したことがあれば、なお良いのですが、なくてもキーを押していくだけです。後は、私が、マクロがどのぐらい相手本位に作っているか、とか、私がご質問を勘違いしていなかったとか、とか、私自身の問題だと思います。今回は、内容こそは簡単なのですが、細かいところに気を使ったつもりです。コアになる部分は、ほんのちょっとで、後は、ユーザーさんをまご付かせないための配慮です。

※ マクロの取り付け方
Alt　+　 F11 (Altを押しながらF11）を押すと、Visual Basic Editor 画面が出てきます。
次に、メニューの[挿入]－[標準モジュール]と開けて、クリックすると、画面が現れますので、以下のコードを貼り付けて、

貼り付けたら、Alt　+　Q で、画面を閉じます。

'<標準モジュールに貼り付けてください。>
'---------------------------------------------------
'Option Explicit
Sub CopyArrangePickup()
'出社・帰社データを振り分けるマクロ
　 Dim inData() As Variant
　 Dim outData() As Variant
　 Dim i As Long
　 Dim j As Long
　 Dim k As Long
　 Dim r As Range
　 Dim r1 As Range
　 Dim r2 As Range
　 Dim mRow1 As Long
　 Dim mRow2 As Long
　 Dim PastePos As Range
　 ReDim inData(1, 0)
　 ReDim outData(1, 0)

　 'フィルター選択モードチェック
　 If ActiveSheet.FilterMode = False Then MsgBox "オートフィルターの選択モードではありません。", 64: Exit Sub

　 'データ取得
　 On Error Resume Next
　 Application.SendKeys "{HOME}{END}"
　 Set r = Application.InputBox("データソースの左上端のタイトル・セルを選択してください。", "データコピー", "$A$1", Type:=8)
　 If r Is Nothing Then Exit Sub
　 Set r = r.Cells(1)
　 Beep
　 Set r1 = Range(r, r.End(xlDown)).Resize(, 5) '必要なデータが5列目まで
　 On Error GoTo 0

　 If r1 Is Nothing Then: Exit Sub
　 If Not (WorksheetFunction.CountA(r1.Rows(1)) = 5 And r.Cells(1).Value <> "") Then MsgBox "正しく最左列を選択してください。", 16: Exit Sub
　 '1行目をタイトル行とする
　 For i = 2 To r1.Rows.Count
　　　ReDim Preserve inData(1, k)
　　　ReDim Preserve outData(1, k)
　　　If r1.Cells.EntireRow.Hidden = False Then
　　　　 inData(0, k) = r1.Cells(i, 1).Value2
　　　　 inData(1, k) = r1.Cells(i, 4).Text
　　　　 outData(0, k) = r1.Cells(i, 2).Value2
　　　　 outData(1, k) = r1.Cells(i, 5).Text
　　　　 k = k + 1
　　　End If
　 Next i

　 'ペースト部分

PasteposFind:

　 On Error Resume Next
　 Set PastePos = Application.InputBox("ペーストする場所の左上端を選択してください。", "データペースト", "$A$1", Type:=8)
　 On Error GoTo 0
　 If PastePos Is Nothing Then Exit Sub
　 If PastePos.Value = "" Or PastePos.Offset(2).Value = "" Then
　　　MsgBox "表がないと貼り付けられません。"
　　　GoTo PasteposFind
　 End If
　 If PastePos.Address = r.Address And _
　 PastePos.Parent.Name = r.Parent.Name Then MsgBox "同じ場所には貼り付けることが出来ません。", 64: GoTo PasteposFind

　 Set r2 = Range(PastePos, PastePos.End(xlDown))
　 Application.Goto r2.Cells(1)
　 With r2.Offset(1, 1).Resize(r2.Rows.Count - 1, 2)
　　 If WorksheetFunction.CountA(.Cells) > 1 Then
　　　 If MsgBox("データのみ削除しますがよろしいですか？", vbOKCancel) = vbCancel Then Exit Sub
　　　　　.ClearContents
　　 End If
　 End With
　 Application.ScreenUpdating = False
　 For j = LBound(inData, 2) To UBound(inData, 2)
　　　On Error Resume Next
　　　mRow1 = 0
　　　mRow1 = WorksheetFunction.Match(inData(0, j), r2, 0)
　　　If mRow1 > 0 And inData(1, j) <> "" Then
　　　　 r2.Cells(mRow1, 2).Value = inData(1, j)
　　　End If
　　　mRow2 = 0
　　　mRow2 = WorksheetFunction.Match(outData(0, j), r2, 0)
　　　If mRow2 > 0 And outData(1, j) <> "" Then
　　　　 r2.Cells(mRow2, 3).Value = outData(1, j)
　　　End If
　　　On Error GoTo 0
　 Next j
　 Set r = Nothing: Set r1 = Nothing: Set r2 = Nothing
　 Set PastePos = Nothing
　 Application.ScreenUpdating = True
End Sub

'-------------貼り付け終わり-----------------------------------

なお、このままですと、起動が面倒なので、できれば、コマンドボタンを取り付けると便利です。（ショートカットですと、他の方が使う時に分りにくいです。）

取り付け方は、メニューバーの何もないところを右クリックすると、カスケードメニューが現れますから、その中で、[コントロールツールボックス]　をクリックしてください。
その中をマウスポインターでなぞっていくと、[コマンドボタン]というクリーム色のポップアップ・ヒントが現れますので、[クリック]

ワークシート上で、適当な場所をドラッグして、四角い枠を囲みますと、ボタンになります。白い小さな四角□が並んでいる状態かと思います。それを[ダブルクリック]すると、画面が、VB エディター画面に変ります。

Private Sub CommandButton1_Click()

End Sub
　　　↑
このようになっていますので、
　　このようにします。そのまま、全部を貼り付けてもよいです。
'-------------------------------
Private Sub CommandButton1_Click()
Call　CopyArrangePickup　'書き込み
End Sub
'-------------------------------

画面の上部のツールバーには、青い三角定規が凹んでいますので、[クリック]

もう一度、Alt + Q で、画面を閉じてしまいます。
また、メニューの何もないところで、右クリックして、カスケードメニューの中の[コントロールツール・ボックス]をクリックすれば、このメニューは消えます。

後は、そのボタンをクリックすれば、実行できます。
○ マクロの実行の前に、

※オート・フィルターで、氏名の1人を選択します。
選択していないと、マクロは、進んでくれません。

ペーストのシートには、すでに、以下のように、時系列に日付が並べられていることが条件です。私の作ったマクロは、日付のあるところを探しますので、ないものは転記してくれません。それを気をつけてください。

データは、どちらも、必ずしも、左端上のA1 から始まっていなくてもよいです。

ペースト先は、

日付　　出社時間　　　退社時間
171216　　←元のソースデータがシリアル値なら、シリアル値で
171217　　統一してください。数字なら数字で可能です。
171218　　文字の数字と数値では、検索しません。
171219
171220
171221
171222
171223
171224　　　　出社時間と退社時間にデータがあると、削除して良いか聞いてきます。

マクロは、順を追って、メッセージボックスが現れます。ペーストする時は、シートを替えることが出来ます。

補足

何も分からない見ず知らずの私に、こんなに丁寧にご回答下さって、本当にありがとうございます（嬉涙(T_T)）
きっと貴重なお時間を割いて作ってくださったのでしょう。
本当に感謝していますm(_ _)m
一応、お教えいただいたとおり、マクロを組んでみましたが、
下のように何故か振り分けがうまくいきませんでした。
どこか私のやり方がおかしいとは思うのですが、もしお時間が有れば、教えてください。

《元のデータ》
出社日　帰社日　氏名　出社時間　帰社時間
171216　171216　伊藤　　　7:20　　　18:30
171216　171217　伊藤　　　19:16　　　10:13
171219　171219　伊藤　　　空白　　　空白
171219　171220　伊藤　　　20:30　　　15:00
171219　171219　伊藤　　　7:50　　　　16:10
171220　171220　伊藤　　　空白　　　空白　　　　　　

《マクロで振り分けたデータ》
日付　　出社時間　　帰社時間
171216　　空白　　　　空白
171217　　空白　　　　空白
171218　　8:45　　　　空白
171219　　9:05　　　　空白
171220　　7:20　　　　空白
171221　　空白　　　　空白

本当にお時間が有るときで結構です。

回答No.8

imogasi

＃６です。＃６は離れた複数行をコピーする方法を述べたもので、この質問には、ふさわしくないですね。
改めて読んでも、質問の例から、何がしたいかよくわかりませんでした。上の表からどうして、下の表が出るのか、例だけでなく、言葉・文章を添えて、説明してみてください。
そのルールあたりは、回答者に推測させるのでなく、質問者側で、並みの回答者にわかるように、説明してほしいです。
＞日付毎に出社時間、退社時間のみ抜き出して、違うシートに作成したいのですが・・
がなぜ質問の下の表になるのか分かりませんでした。

補足

私の説明不足で、皆さんを困惑させてしまうような質問をしてしまい、大変申し訳ありません。Wendy02さんの補足欄にも書きましたように、上の表のおおもとのデータは1日毎に並んでいるわけでもなければ、一行に対して出社日及び出社時間と帰社日及び帰社時間がずれている場合も有り、一貫性が有りません。この一貫性の無いデータを、下の表のような新しいシートの一日毎に並んだ日付列の脇に、時間のみ正確に抜き出してペーストしたいのです。
例えば、上の表の3行目を例に挙げると、
(12月18日に会社を出て、19日に帰社した）

《おおもとのデータ》
出社日　帰社日　氏名　出社時間　帰社時間
171218　171219　伊藤　　　8:00　　　　10:00　　　
　　　　　↑　　　　　　　　　　　　↑
このままだと一行にあるデータが2日間にまたがってしまっているため、コレを一日毎にさせたいのです。
(12月18日に会社を出て、19日に帰社した）

《新しいシート》
　日付　　出社時間　帰社時間
171218　　　8:00　　
171219　　　　　　　　　　10:00　　　

本当に説明がへたくそでごめんなさい。

回答No.7

Wendy02

こんにちは。

少し確認しますが、

ペースト側は、1日ずつ、時系列に並んでいますね。

そして、以下のような元のシートが出来上がっているわけですね。
日付 　　出社時間　　帰社時間
171216
171217
171218
171219
171220
171221

その反面、オートフィルタで、人名で抽出したものは、以下のようになっていて、出社と帰社には、同一の日ではないわけですね。

出社日　帰社日　　出社時間　　帰社時間
171216　171216
171216　171216
171218　171219
171220　171221
171221　171222
171225　171226

必ずしも、1日ずつ並んでいるわけでもなければ、ペースト側に対応した並びになっているわけではありません。もし、そのようでしたら、これを自動的に行うのは、マクロ以外には不可能だと思います。あまり簡単なマクロではないでしょうけれど、もし、マクロでも良いのでしたら、私のほうで作ってみます。

お礼

返信が遅くなってしまい申し訳ありません。
現在、なぜか補足質問の方に書き込みが出来ない状態のため、お礼の方に補足を書かせていただきます。
Wendy02さんのおっしゃるとおりです。
おおもとのデータは必ずしも、1日ずつ並んでいるわけでもなければ、出社日と帰社日が揃っているわけでもないのです。
私はまだまだExcel初心者のため、《マクロ》というものはまったくもって分かりません。このような私でも分かるようであれば、教えていただけたら幸いです。
マクロが理解できていないと無理なようでしたら、はっきりおっしゃっていただけたらありがたいです。

回答No.6

imogasi

昨日も、似た質問があったが、
（１）Ｓｈｅｅｔ１で、日付の列（Ａ列）の列番号（記号）部をクリック
(注意）このとき、ＣＴＲＬキーを押さないこと（肝心）
（２）ＣＴＲＬキーを押し始めて、押したまま出社時間（Ｄ列）と退社時間の列（Ｅ列）をクリックする。
これで３列全体が選択される。
（３）編集ーコピー
（４）Ｓｈｅｅｔ２とかに意って、Ａ１をポイントして、編集－貼り付け
（結果）
Ａ、Ｂ，Ｃ列にＳｈｅｅｔのＡ，Ｄ，Ｅ列が列的に詰めて複写される。
編集ーコピーなどは、ＣＴＲＬ＋Ｃ，ＣＴＲＬ＋Ｖでも可。
（１）のだんかいからＣＴＲＬを押すとエラーになるでしょう。

お礼

返信が遅くなってしまい申し訳ありません。
この方法ですと、おおもとのデータを見ると、一行に対して出社日と帰社日がずれてしまっている場合があるため、新しいシートの日付列の脇にうまくペーストすることが出来ません。
アドバイスありがとうございます。

回答No.5

walsh

こんにちは。

まず、基のシートの複製を作成する。
オートフィルタを解除して、全データを表示させる。
データの範囲を全て選択して、並べ替えを
最優先キー：氏名、２番目の優先キー：出社日　で実行する。

この操作で、基のデータが、氏名順・出社日順に並べ変わりますので、
その後で不要な列を削除したらどうでしょうか。

お礼

返信が遅くなってしまい申し訳ありません。
この方法ですと、おおもとのデータを見ると、一行に対して出社日と帰社日がずれてしまっている場合があるため、新しいシートの日付列の脇にうまくペーストすることが出来ません。
アドバイスありがとうございます。

回答No.4

cockerel

何となくわかりました。
抜けている日付を入力し、残りをダミーデータもしくは空白にします。
一例：
飛び飛びのデータの日付を新しい列にコピーします。
その後ろに連続日付データを作成します。
日付およびデータ（日付を優先）で全体をソートします。
日付セルの1つ上を参照して同じ日付でないときに日付セルをコピー、同じときは空白という関数のセルを作ります。
最後に関数のセルのある列でソートし、コピーして値（式が含まれているため）をペーストします。
これで
171216　171216
171217
171218 171218
171219
171220 171220
のようになると思います。
より具体的な方法が必要でしたら、おっしゃってください。また書き込みます。
はずれでしたら、ごめんなさい（よくあります）。

補足

返信が遅くなってしまい、申し訳ありません。
私自身、Excelがまだまだ理解できていない部分が多いため、関数に関しては本当に初歩的なものしか分かりません。
もしお時間があれば、
＞日付セルの1つ上を参照して同じ日付でないときに日付セルをコピー、同じときは空白という関数
を教えていただければ幸いです。