การ Timestamp Date/Time ตามเงื่อนไขที่กำหนด

[March]

ตามไฟล์แนบครับ

timestamp_test.xlsm

1. ผมต้องการให้ป้อนข้อมูลลงในคอลัมน์ A2,B2,C2,D2,E2 แล้ววันที่และเวลาจะขึ้นเองอัตโนมัติในคอลัมน์ F2
2. ป้อนข้อมูลลงใน H2 แล้ววันที่และเวลาจะแสดงในคอลัมน์ G2
โดยที่วันที่และเวลาที่แสดงจะต้องไม่เปลี่ยนเป็นวันและเวลาล่าสุด ถ้าหากป้อนข้อมูลใน Row ถัดไป (Row3)
ตอนแรกผมใช้สูตร =IF(AND(A2<>"",B2<>"",C2<>"",D2<>"",E2<>""),NOW(),"") พอขึ้นบรรทัดใหม่เวลาก็เปลี่ยนเหมือนกันหมดตามข้อมูลล่าสุด

ผมเลยลองเขียน VBA ได้สูตรดังนี้ครับ
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 And Target.Value <> "" Then
A = Target.Offset(0, 1).Value
B = Target.Offset(0, 2).Value
C = Target.Offset(0, 3).Value
D = Target.Offset(0, 4).Value
If A <> "" And B <> "" And C <> "" And D <> "" Then
Target.Offset(0, 5) = Now()
Else
Target.Offset(0, 5) = ""
End If
ElseIf Target.Column = 2 And Target.Value <> "" Then
A = Target.Offset(0, -1).Value
B = Target.Offset(0, 1).Value
C = Target.Offset(0, 2).Value
D = Target.Offset(0, 3).Value
If A <> "" And B <> "" And C <> "" And D <> "" Then
Target.Offset(0, 4) = Now()
Else
Target.Offset(0, 4) = ""
End If
ElseIf Target.Column = 3 And Target.Value <> "" Then
A = Target.Offset(0, -2).Value
B = Target.Offset(0, -1).Value
C = Target.Offset(0, 1).Value
D = Target.Offset(0, 2).Value
If A <> "" And B <> "" And C <> "" And D <> "" Then
Target.Offset(0, 3) = Now()
Else
Target.Offset(0, 3) = ""
End If
ElseIf Target.Column = 4 And Target.Value <> "" Then
A = Target.Offset(0, -3).Value
B = Target.Offset(0, -2).Value
C = Target.Offset(0, -1).Value
D = Target.Offset(0, 1).Value
If A <> "" And B <> "" And C <> "" And D <> "" Then
Target.Offset(0, 2) = Now()
Else
Target.Offset(0, 2) = ""
End If
ElseIf Target.Column = 5 And Target.Value <> "" Then
A = Target.Offset(0, -4).Value
B = Target.Offset(0, -3).Value
C = Target.Offset(0, -2).Value
D = Target.Offset(0, -1).Value
If A <> "" And B <> "" And C <> "" And D <> "" Then
Target.Offset(0, 1) = Now()
Else
Target.Offset(0, 1) = ""
End If
End If
If Target.Column = 1 And Target.Value = "" Then
Target.Offset(0, 5) = ""
ElseIf Target.Column = 2 And Target.Value = "" Then
Target.Offset(0, 4) = ""
ElseIf Target.Column = 3 And Target.Value = "" Then
Target.Offset(0, 3) = ""
ElseIf Target.Column = 4 And Target.Value = "" Then
Target.Offset(0, 2) = ""
ElseIf Target.Column = 5 And Target.Value = "" Then
Target.Offset(0, 1) = ""
End If
If Target.Column = 8 And Target.Value <> "" Then
Target.Offset(0, -1) = Now()
ElseIf Target.Column = 8 And Target.Value = "" Then
Target.Offset(0, -1) = ""
End If
End Sub

แล้วเกิดปัญหาว่า หากผมทำการลบข้อมูลที่ป้อนเข้าไป ผมลบได้ที่ละช่องไม่สามารถที่จะลากแถบเลือกลบทีละหลายช่องได้
ขึ้นเตือนว่า Run Time ERROR >> Type missmatch >> End/Debug
เป็นเพราะอะไรและควรแก้ไขอย่างไรครับ รบกวนอาจารย์ช่วยเหลือด้วยครับ

[snasui]

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim isect1 As Range, iSect2 As Range
    With Application
        Set isect1 = .Intersect(Target, Range("a:e"))
        Set iSect2 = .Intersect(Target, Range("h:h"))
    End With
    If Not isect1 Is Nothing Then
        If Application.CountIf(Range(Cells(Target.Row, 1), _
            Cells(Target.Row, 5)), "") > 0 Then
            Exit Sub
        Else
            Cells(Target.Row, 6) = Now()
        End If
    End If
    If Not iSect2 Is Nothing And Target = "" Then
        Target.Offset(0, -1) = Now()
    End If
End Sub