Xem giúp em code vba cho file đăng ký làm thêm giờ

[nguyentheviet86]

Thân gửi anh chị, nhờ anh chị xem giúp em code cho file
Tại sheet Data nếu ko nhập đầy đủ thông tin tại cột C-> E và H->J thì sẽ không nhập vào dữ liệu ạ
Em xin cảm ơn !

 

[BuiQuangThuan]

Sao bạn lập lắm toppic thế?
Thêm điều kiện vào trước khi làm gì đó là được mà

 

[nguyentheviet86]

Sao bạn lập lắm toppic thế?
Thêm điều kiện vào trước khi làm gì đó là được mà

vì em chưa biết code nhiều nên mong anh chị giúp đỡ ạ

 

[BuiQuangThuan]

vì em chưa biết code nhiều nên mong anh chị giúp đỡ ạ

Sửa thử như này coi có đúng ý bạn không?

Sub dkot()

Dim lr1, lr2 As Long
Dim rng As Range
Dim datetc As Date
Dim ckdt As Boolean

lr1 = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
lr2 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
datetc = Sheet1.Range("h9").value
If datetc > 0 And Sheet1.Range("e9").value <> "" And Sheet1.Range("H9").value <> "" And Sheet1.Range("J9").value <> "" And lr1 > 12 Then
    ckdt = True
Else
    If datetc = 0 Then
        ckdt = False
        MsgBox " OT date is emplty", , "Thoa Hana"
        Exit Sub
    End If
    If lr1 <= 12 Then
        ckdt = False
        MsgBox "Data is empty", , "Thoa Hana"
        Exit Sub
    End If
End If
If ckdt = True Then
    Sheet3.Range("A" & lr2 + 1 & ":A" & lr2 + lr1 - 12) = Now
    Sheet3.Range("B" & lr2 + 1 & ":B" & lr2 + lr1 - 12) = datetc
    Sheet3.Range("C" & lr2 + 1 & ":K" & lr2 + lr1 - 12) = Sheet1.Range("C13:K" & lr1).value
    Sheet1.Range("B13:K" & lr1) = ""
    MsgBox "Done", , "Thoa Hana"
End If
End Sub

 

[nguyentheviet86]

Sửa thử như này coi có đúng ý bạn không?

Sub dkot()

Dim lr1, lr2 As Long
Dim rng As Range
Dim datetc As Date
Dim ckdt As Boolean

lr1 = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
lr2 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
datetc = Sheet1.Range("h9").value
If datetc > 0 And Sheet1.Range("e9").value <> "" And Sheet1.Range("H9").value <> "" And Sheet1.Range("J9").value <> "" And lr1 > 12 Then
    ckdt = True
Else
    If datetc = 0 Then
        ckdt = False
        MsgBox " OT date is emplty", , "Thoa Hana"
        Exit Sub
    End If
    If lr1 <= 12 Then
        ckdt = False
        MsgBox "Data is empty", , "Thoa Hana"
        Exit Sub
    End If
End If
If ckdt = True Then
    Sheet3.Range("A" & lr2 + 1 & ":A" & lr2 + lr1 - 12) = Now
    Sheet3.Range("B" & lr2 + 1 & ":B" & lr2 + lr1 - 12) = datetc
    Sheet3.Range("C" & lr2 + 1 & ":K" & lr2 + lr1 - 12) = Sheet1.Range("C13:K" & lr1).value
    Sheet1.Range("B13:K" & lr1) = ""
    MsgBox "Done", , "Thoa Hana"
End If
End Sub

Em coppy mã code vào nhưng khi nhập xong bấm nút Update không nhập được dữ liệu vào ạ

 

[BuiQuangThuan]

Em coppy mã code vào nhưng khi nhập xong bấm nút Update không nhập được dữ liệu vào ạ

Chỉ cần 4 cái ô C,E,H,J9 mà không có dữ liệu thì sẽ không nhập được

 

[nguyentheviet86]

Chỉ cần 4 cái ô C,E,H,J9 mà không có dữ liệu thì sẽ không nhập được

CỘT C,D,E,H,I,J không có dữ liệu thfi sẽ không nhập được ạ

 

[BuiQuangThuan]

CỘT C,D,E,H,I,J không có dữ liệu thfi sẽ không nhập được ạ

Ý bạn là như thế mà

Tại sheet Data nếu ko nhập đầy đủ thông tin tại cột C-> E và H->J thì sẽ không nhập vào dữ liệu ạ

 

[nguyentheviet86]

Ý bạn là như thế mà

nhưng em đánh đầy đủ các thông tin ở các cột khi bấm update thì không ra dữ liệu ạ

 

[BuiQuangThuan]

nhưng em đánh đầy đủ các thông tin ở các cột khi bấm update thì không ra dữ liệu ạ

Sửa lại code

Sub dkot()

Dim lr1, lr2 As Long
Dim rng As Range
Dim datetc As Date
Dim ckdt As Boolean

lr1 = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
lr2 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
datetc = Sheet1.Range("h9").value
If datetc > 0 And Sheet1.Range("C9").value <> "" And Sheet1.Range("E9").value <> "" And Sheet1.Range("H9").value <> "" And lr1 > 12 Then
    ckdt = True
Else
    If datetc = 0 Then
        ckdt = False
        MsgBox " OT date is emplty", , "Thoa Hana"
        Exit Sub
    End If
    If lr1 <= 12 Then
        ckdt = False
        MsgBox "Data is empty", , "Thoa Hana"
        Exit Sub
    End If
End If
If ckdt = True Then
    Sheet3.Range("A" & lr2 + 1 & ":A" & lr2 + lr1 - 12) = Now
    Sheet3.Range("B" & lr2 + 1 & ":B" & lr2 + lr1 - 12) = datetc
    Sheet3.Range("C" & lr2 + 1 & ":K" & lr2 + lr1 - 12) = Sheet1.Range("C13:K" & lr1).value
    Sheet1.Range("B13:K" & lr1) = ""
    MsgBox "Done", , "Thoa Hana"
End If
End Sub

 

[nguyentheviet86]

Sửa lại code

Sub dkot()

Dim lr1, lr2 As Long
Dim rng As Range
Dim datetc As Date
Dim ckdt As Boolean

lr1 = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
lr2 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
datetc = Sheet1.Range("h9").value
If datetc > 0 And Sheet1.Range("C9").value <> "" And Sheet1.Range("E9").value <> "" And Sheet1.Range("H9").value <> "" And lr1 > 12 Then
    ckdt = True
Else
    If datetc = 0 Then
        ckdt = False
        MsgBox " OT date is emplty", , "Thoa Hana"
        Exit Sub
    End If
    If lr1 <= 12 Then
        ckdt = False
        MsgBox "Data is empty", , "Thoa Hana"
        Exit Sub
    End If
End If
If ckdt = True Then
    Sheet3.Range("A" & lr2 + 1 & ":A" & lr2 + lr1 - 12) = Now
    Sheet3.Range("B" & lr2 + 1 & ":B" & lr2 + lr1 - 12) = datetc
    Sheet3.Range("C" & lr2 + 1 & ":K" & lr2 + lr1 - 12) = Sheet1.Range("C13:K" & lr1).value
    Sheet1.Range("B13:K" & lr1) = ""
    MsgBox "Done", , "Thoa Hana"
End If
End Sub

Code dưới này thì em nhập không đầy đủ thông tin CỘT C,D,E,H,I,J thì vẫn update được vào dữ liệu ạ

 

[BuiQuangThuan]

Code dưới này thì em nhập không đầy đủ thông tin CỘT C,D,E,H,I,J thì vẫn update được vào dữ liệu ạ

Mình không biết bạn thử như nào. Nhưng khi mình điền đầy đủ và để trống ô H9 hoặc C9 thì nó sẽ không thực hiện nhập mà

 

[nguyentheviet86]

Mình không biết bạn thử như nào. Nhưng khi mình điền đầy đủ và để trống ô H9 hoặc C9 thì nó sẽ không thực hiện nhập mà
View attachment 271305

Cái dòng thử 9 không có vấn đề gì ạ, ý em là bắt đầu nhập thông tin tại dòng 13, khi dòng 13 không nhập đủ dữ liệu tại cột C,D,E,H,I,J thì bấm nút update không ra số liệu ạ
Em xin lỗi anh chị vì em không nói rõ tại dòng và cột thứ bao nhiêu

 

[BuiQuangThuan]

Cái dòng thử 9 không có vấn đề gì ạ, ý em là bắt đầu nhập thông tin tại dòng 13, khi dòng 13 không nhập đủ dữ liệu tại cột C,D,E,H,I,J thì bấm nút update không ra số liệu ạ
Em xin lỗi anh chị vì em không nói rõ tại dòng và cột thứ bao nhiêu

chót:

Sub dkot()
Dim tungay, denngay
Dim lr1, lr2 As Long
Dim rng As Range
Dim datetc As Date
Dim ckdt As Boolean

lr1 = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
lr2 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
datetc = Sheet1.Range("h9").value
tungay = Sheet1.Range("c9").value
denngay = Sheet1.Range("E9").value

If datetc > 0 And tungay <> "" And denngay <> "" And lr1 > 12 Then

    ckdt = True
Else
    If datetc = 0 Then
        ckdt = False
        MsgBox " OT date is emplty", , "Thoa Hana"
        Exit Sub
    End If
    If lr1 <= 12 Then
        ckdt = False
        MsgBox "Data is empty", , "Thoa Hana"
        Exit Sub
    End If
End If

If ckdt = True And (lr1 - 12) * 6 = Sheet1.Cells(1, 1).value Then
    Sheet3.Range("A" & lr2 + 1 & ":A" & lr2 + lr1 - 12) = Now
    Sheet3.Range("B" & lr2 + 1 & ":B" & lr2 + lr1 - 12) = datetc
    Sheet3.Range("C" & lr2 + 1 & ":K" & lr2 + lr1 - 12) = Sheet1.Range("C13:K" & lr1).value
   
    Sheet1.Range("B13:K" & lr1) = ""
    MsgBox "Done", , "Thoa Hana"
Else
    MsgBox "Nhap thieu du lieu. Kiem tra lai"
End If

End Sub

 

[nguyentheviet86]

chót:

Sub dkot()
Dim tungay, denngay
Dim lr1, lr2 As Long
Dim rng As Range
Dim datetc As Date
Dim ckdt As Boolean

lr1 = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
lr2 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
datetc = Sheet1.Range("h9").value
tungay = Sheet1.Range("c9").value
denngay = Sheet1.Range("E9").value

If datetc > 0 And tungay <> "" And denngay <> "" And lr1 > 12 Then

    ckdt = True
Else
    If datetc = 0 Then
        ckdt = False
        MsgBox " OT date is emplty", , "Thoa Hana"
        Exit Sub
    End If
    If lr1 <= 12 Then
        ckdt = False
        MsgBox "Data is empty", , "Thoa Hana"
        Exit Sub
    End If
End If

If ckdt = True And (lr1 - 12) * 6 = Sheet1.Cells(1, 1).value Then
    Sheet3.Range("A" & lr2 + 1 & ":A" & lr2 + lr1 - 12) = Now
    Sheet3.Range("B" & lr2 + 1 & ":B" & lr2 + lr1 - 12) = datetc
    Sheet3.Range("C" & lr2 + 1 & ":K" & lr2 + lr1 - 12) = Sheet1.Range("C13:K" & lr1).value
  
    Sheet1.Range("B13:K" & lr1) = ""
    MsgBox "Done", , "Thoa Hana"
Else
    MsgBox "Nhap thieu du lieu. Kiem tra lai"
End If

End Sub

Được rồi ạ, em cảm ơn anh chị ạ