1408675958 エクセルVBA マクロの作成をお願い致します。


図の通り日付順に入室時間、退室時間が記入された空の表があります。
そこにAデータから日付に合わせて入室時間、退室時間を貼り付けていきます
※Aデータは日付が飛び飛びです。
最終的に完成形のようにしたいです。
空のデータ、Aデータを両方開いている状態から完成形にもっていくマクロをお願い致します。
環境はオフィス2007 win7です。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2014/08/22 11:52:38
  • 終了:2014/08/24 22:00:23

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912014/08/23 01:34:36

ポイント300pt

シートをどのように指定するかの説明がないので、取りあえず対象シートでセルを選択することで代用しています(A1セルに特に意味はありません)。

Sub Sample()
    Dim 選択セル As Range
    
    On Error Resume Next
    
    Set 選択セル = Application.InputBox("転記元シートの A1セルを選択してください。", "シート選択", Type:=8)
    If 選択セル Is Nothing Then Exit Sub
    
    Dim srcWS As Worksheet
    Set srcWS = 選択セル.Parent
    
    Set 選択セル = Application.InputBox("転記先シートの A1セルを選択してください。", "シート選択", Type:=8)
    If 選択セル Is Nothing Then Exit Sub
    
    Dim dstWS As Worksheet
    Set dstWS = 選択セル.Parent
    
    On Error GoTo 0
    Dim c As Long
    For c = 1 To srcWS.Cells(1, Columns.Count).End(xlToLeft).Column Step 2
        If IsDate(srcWS.Cells(1, c).Value) = True Then
            Set 選択セル = dstWS.Rows(1).Find(what:=DateValue(srcWS.Cells(1, c).Value), LookIn:=xlFormulas)
            If Not 選択セル Is Nothing Then
                srcWS.Cells(3, c).Resize(srcWS.UsedRange.Rows.Count, 2).Copy _
                    dstWS.Cells(3, 選択セル.Column).Resize(srcWS.UsedRange.Rows.Count, 2)
            End If
        End If
    Next
End Sub
id:tyyyu2005

ありがとうございます。
動作確認致しました。

2014/08/24 21:55:25

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません