Excel VBA毎月計時

Question

毎日の計時に約30名の従業員が使用する共有Excelタイムシートを作成しようとしています。

この計時シートは、彼らのために従業員の日々のタイムスタンプを記録します：

時間：私は、特定の従業員がために彼/彼女のタイムスタンプを記録するためにCheckBoxをチェックでき、フォームインタフェースを作成し

Start of Pre-shift OverTime, End of Pre-shift Overtime, 
Time-In, Time-Out, 
Start of 1st break, End of 1st break, 
Start of Lunch, End of Lunch, 
Start of 2nd break, End of 2nd break, 
Start of Post-shift OverTime, End of Post-shift Overtime, Etc. 

-In、タイムアウト、1回目のブレークの開始、1回目のブレークの終了など。タイムスタンプは、その日のその従業員のすべてのタイムスタンプをキャプチャするSheet2のテーブルに転送されます。

私の問題はです。従業員が翌日に仕事に戻ると、前日のタイムスタンプはすべて、現在の日時のタイムスタンプで上書きされます。

エキスパートが私にサンプルコードを教えましたが、「時間保存」シートのデータは1行に水平に表示されないようです。代わりに、それは下向き斜めのパターンで現れる。

あなたが何らかの形で私を助けることができれば、それは非常に高く評価されます。

以下

はサンプルコードです：

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim rngC As Range 
    Dim lngR As Long 
    Dim shtS As Worksheet 

    Set shtS = Worksheets("Time Storage") 

    If Intersect(Target, Range("B4:B12")) Is Nothing Then Exit Sub 

    lngR = shtS.Cells(shtS.Rows.Count, "A").End(xlUp).Row 

    If shtS.Cells(lngR, "A").End(xlUp).Value <> Date Then 
     lngR = shtS.Cells(shtS.Rows.Count, "A").End(xlUp).Row + 1 
     shtS.Cells(lngR, "A").Value = Date 
    End If 

    For Each rngC In Intersect(Target, Range("B4:B12")) 
     If rngC.Value <> "" Then 
      shtS.Cells(lngR, rngC.Row - 2).Value = Target.Value 
     End If 
    Next rngC 

End Sub 

（Iは細胞内にタイムスタンプを入力します。「タイムエントリ」という名前のシートの「B4 B12」、と私は名前のシートのMを通じて列Bにそれらを保存します「タイムストレージ」

問題がです。。。「時間記憶」シート内のデータは、1つの行に水平に表示されていないようです代わりに、それは下向き斜めのパターンで表示されます）

編集：スクリーンショットの共有：

"Time Entry" Sheet

"Time Storage" Sheet

Answer 1

あなたはスクリーンショットが含まれている場合には診断するのが容易になります。私はTime Storageのすべての行に列Aの日付が残っていて、残りの列は斜めに塗りつぶされていると仮定しています。

コードはWorksheet_Changeイベントで実行されます。つまり、セルが変更されるたびに実行されます。個々のセルが変更されると、すべてのコードが実行され、一度に1つの値しか持たない1つの余分な行が追加されます。

実際には、最後のセルが更新されたときにコードが一度だけ実行されるようにしてください。順序でセルを埋めると仮定すると、ターゲット範囲がB12と交差するときにコードが1回だけ実行されます。だから、このチェック：

If Intersect(Target, Range("B4:B12")) Is Nothing Then Exit Sub 

は次のようになります。

If Intersect(Target, Range("B12")) Is Nothing Then Exit Sub 

、その後、ループは、すべてのセルを介して実行する必要があります。だから、RNGCは、Cellの代わりの範囲とループのように宣言する必要があります。

​​

は、実際にする必要があります：

For Each rngC In Range("B4:B12")