別シートからの氏名の日付を入力

質問

シートAの表のような日付割り氏名欄があり個人がいつ出勤したか実績の月日をシートBの氏名ごとの出勤日を入力し回数を計上したいのですがどなたかExcel関数もしくはVBA関数の解る方よろしくお願いします。

回答No.2

real beatin（@realbeatin）

マクロを書きました。
どこでもいいので、元の表の内側のセルを選択してある状態
から実行すると、新しいシートに作表します。
条件の説明がなく、添付画像だけが頼りで書いていますから、
元の表やその周辺のレイアウトが画像と違っている場合は、
手当てを加えて使うことになります。
一旦は、添付画像の元となった表で験してみてください。
Excelのバージョンは、2000-2003あたりのようですが、
Excelに関してはバージョン互換を図った内容にしました。
OSに関してはWindows限定（Macでは動かないと思います）です。
この手の回答は、使用環境に合わせて内容を工夫することにも
神経を使います。（万能なものは意外に無いものなので。）
以後、OSやOfficeのバージョン等必要な情報として、
ご使用の環境を開示して質問するようにして下さいませ。
その方が回答し易くなる分、回答を受ける機会も増え、
問題解決の可能性も高まることになろうかと思われますので。

' ' // 元の表 の内にあるセルを選択してから実行
Sub Re9377246Wa()
Dim oDict As Object, rSrc As Range, c As Range
Dim vP, sTmp As String, cnP As Long, i As Long
　　Set oDict = CreateObject("Scripting.Dictionary")
　　Set rSrc = Selection.CurrentRegion _
　　　　.Offset(, 1).SpecialCells(xlCellTypeConstants, xlNumbers)
　　For Each c In rSrc
　　　　For i = 3 To 7
　　　　　　sTmp = c(i, 1)
　　　　　　If sTmp <> "" Then oDict(sTmp) = oDict(sTmp) & vbTab & c.Text
　　　　Next i
　　Next
　　cnP = oDict.Count
　　With Worksheets.Add(After:=ActiveSheet).Cells(3, 2)
　　　　For i = 0 To cnP - 1
　　　　　　.Cells(i + 1, 1) = oDict.Keys(i) & oDict.Items(i)
　　　　Next i
　　　　.Resize(cnP).TextToColumns _
　　　　　　Destination:=.Cells, DataType:=xlDelimited, Tab:=True, _
　　　　　　Semicolon:=False, Comma:=False, Space:=False, Other:=False
　　　　.Cells(0).Resize(, 2) = Array("氏名", "日付")
　　　　With .CurrentRegion
　　　　　　.Borders.LineStyle = xlContinuous
　　　　　　.Columns.AutoFit
　　　　　　.Cells(2).Resize(, .Columns.Count - 1).Merge
　　　　　　.HorizontalAlignment = xlCenter
　　　　End With
　　End With
End Sub
' ' //

お礼

有難うございます。勉強になりました。