、2個の細胞における日時を自動充填

Question

I iは、列Aの値のを追加すると、列Bの日付を自動的に埋めることになる次のコードを有する

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim A As Range, B As Range, Inte As Range, r As Range 
    Set A = Range("A:A") 
    Set Inte = Intersect(A, Target) 
    If Inte Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
     For Each r In Inte 
      If r.Offset(0, 1).Value = "" Then 
       r.Offset(0, 1).Value = Date & " " & Time = "hh:mm:ss AM/PM" 
      End If 
     Next r 
    Application.EnableEvents = True 
End Sub 

を探して何イムも列に現在の時刻を追加することであるC.

OKだから私は何を探してイム見つかりましたが、それは、日付と時刻が設定されている少し変更する必要があります。以下 は

代わり列Bの、経時代わりカラムA および自動充填カラムFの日付で自動充填カラムEにコード

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim A As Range, B As Range, Inte As Range, r As Range 
Set A = Range("D:D") 
Set Inte = Intersect(A, Target) 
If Inte Is Nothing Then Exit Sub 
Application.EnableEvents = False 
    For Each r In Inte 
     If r.Value > 0 Then 
      r.Offset(0, -3).Value = Date 
      r.Offset(0, -3).NumberFormat = "dd-mm-yyyy" 
      r.Offset(0, -2).Value = Time 
      r.Offset(0, -2).NumberFormat = "hh:mm:ss AM/PM" 
     Else 
      r.Offset(0, -3).Value = "" 
      r.Offset(0, -2).Value = "" 
     End If 
    Next r 
Application.EnableEvents = True 
End Sub 

であり、可能なImが有するようにしようとする場合同じプロセスであるが、同じシート上の別のセル。

Answer 1

あなたは1本のヒットではなく、ループ内でこれを行うにはSpecialCellsを使用して見てかもしれませんが、あなたのコードに簡単なMODは次のようになります。

範囲の面積法

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim A As Range, B As Range, Inte As Range, r As Range 
    Set A = Range("A:A") 
    Set Inte = Intersect(A, Target) 
    If Inte Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
    On Error Resume Next 
    For Each r In Inte.Areas 
     r.Offset(0, 1).Cells.SpecialCells(xlCellTypeBlanks) = Date 
     r.Offset(0, 2).Cells.SpecialCells(xlCellTypeBlanks) = Time 
    Next r 
    Application.EnableEvents = True 
End Sub 

ごとのワンショット

初期答え

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim A As Range, B As Range, Inte As Range, r As Range 
    Set A = Range("A:A") 
    Set Inte = Intersect(A, Target) 
    If Inte Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
     For Each r In Inte 
      If r.Offset(0, 1).Value = vbNullString Then r.Offset(0, 1).Value = Date 
      If r.Offset(0, 2).Value = vbNullString Then r.Offset(0, 2).Value = Time 
     Next r 
    Application.EnableEvents = True 
End Sub 

Answer 2

あなたがしたい場合：

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Intersect(Range("A:A"), Target).Address <> Target.Address Then Exit Sub '<--| exit if all target cells aren't in column "A" 
    Application.EnableEvents = False 
    If WorksheetFunction.CountBlank(Target.Offset(, 1)) = 0 Then Exit Sub '<--| exit if no blank cells in target adjacent column 
    With Target.Offset(, 1).SpecialCells(xlCellTypeBlanks) '<--| reference blank cells in target adjacent column 
     .Value = Date '<--| set referenced cells value to the current date 
     .Offset(, 1).Value = Time '<--| set referenced cells adjacent ones value to the current time 
    End With 
    Application.EnableEvents = True 
End Sub 

を：

• は

• は、以下のように行って、その後Target隣接する列の空白セルに隣接するセル

を、現在の時間を置くTarget隣接する列の空白セルに現在の日付を入れてあなたがしたい場合：

• は

• がTarget 2列に現在時刻を入れTarget隣接する列の空白セルに現在の日付を入れるように行くその後、空白のセル

オフセット、次のとおりです。

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Intersect(Range("A:A"), Target).Address <> Target.Address Then Exit Sub '<--| exit if all target cells aren't in column "A" 
    Application.EnableEvents = False 
    On Error Resume Next 
    Target.Offset(, 1).SpecialCells(xlCellTypeBlanks).Value = Date '<--| set target adjacent column blank cells to the current date 
    Target.Offset(, 2).SpecialCells(xlCellTypeBlanks).Value = Time '<--| set target two columns offset blank cells to the current time 
    Application.EnableEvents = True 
End Sub 

On Error Resume Nextは、2つの異なるを避けるためにあるIf WorksheetFunction.CountBlank(someRange) Then someRange.SpecialCells(xlCellTypeBlanks).Value = someValueステートメント

通常は、On Error Resume Nextステートメントを避けて、起こりうるエラーを処理してください。

しかし、この場合には、それはサブの最後の二つの文に限定されて、私は実際にその制御を失うことなく、それは、コードの可読性の賛成で良いトレードオフだと思う