Bổ sung thêm khoảng nghỉ cho đoạn trong đoạn code

[tuan16]

Em có sưu tầm được đoạn code trên diễn đàn. đoạn code có NghiBD1; NghiKT1.. em muốn bổ sung ngày nghỉ cho đoạn code là NghiBD2; NghiKT2; NghiBD3; NghiKT3 thì cần bổ sung thế nào ạ. Em xin nhờ anh chị giúp đỡ.. đoạn code em sưu tầm đây ạ
Sub ngaytd()
Dim VungDL As Range
Dim CotDL As String
Dim CellDL As Range
Dim BatDau As Long
Dim KetThuc As Long
Dim NghiBD1 As Long
Dim NghiKT1 As Long


Dim DuLieuViTri As String
Dim KyTuBatDau As String
Dim KyTuKetThuc As String
Dim KyTu As String
Dim Trai As String
Dim Phai As String
Dim TachKyTu As String
Dim ViTriBD As Integer
Dim ViTriKT As Integer
Dim DongNgay As Integer
Dim LechNgay As Integer
Dim Khoang As Integer
Dim i As Integer

'Vùng nhâp du liêu.'
KyTuBatDau = "s"
KyTuKetThuc = "f"
NghiBD1 = Range("L1").Value
NghiKT1 = Range("M1").Value


Set VungDL = Range("N8:N1000")
CotDuLieu = Mid(VungDL.Address, 2, 1)

'Xu ly du lieu:
Application.Calculation = xlCalculationManual
For i = VungDL.Row To VungDL.Row + VungDL.Rows.Count
Set CellDL = Range(CotDuLieu & i)

If CellDL.Value <> "" Then
'Tach so va ky tu:
If InStr(1, CellDL.Value, KyTuBatDau) > 0 Then
KyTuBatDau = KyTuBatDau
ElseIf InStr(1, CellDL.Value, UCase(KyTuBatDau)) > 0 Then
KyTuBatDau = UCase(KyTuBatDau)
ElseIf InStr(1, CellDL.Value, LCase(KyTuBatDau)) > 0 Then
KyTuBatDau = LCase(KyTuBatDau)
End If
If InStr(1, CellDL.Value, KyTuKetThuc) > 0 Then
KyTuKetThuc = KyTuKetThuc
ElseIf InStr(1, CellDL.Value, UCase(KyTuKetThuc)) > 0 Then
KyTuKetThuc = UCase(KyTuKetThuc)
ElseIf InStr(1, CellDL.Value, LCase(KyTuKetThuc)) > 0 Then
KyTuKetThuc = LCase(KyTuKetThuc)
End If

DuLieuViTri = Replace(CellDL.Value, KyTuBatDau & KyTuBatDau, "cbtuan@gmail.com")
DuLieuViTri = Replace(DuLieuViTri, KyTuBatDau & KyTuKetThuc, "cbtuan@gmail.com")
DuLieuViTri = Replace(DuLieuViTri, KyTuKetThuc & KyTuBatDau, "cbtuan@gmail.com")
DuLieuViTri = Replace(DuLieuViTri, KyTuKetThuc & KyTuKetThuc, "cbtuan@gmail.com")

ViTriBD = InStr(1, DuLieuViTri, "cbtuan@gmail.com")
ViTriKT = ViTriBD + Len("cbtuan@gmail.com")

If ViTriBD = 0 Then
'Xac dinh dong ngay:
Trai = DuLieuViTri
If IsNumeric(Trai) = True Then
DongNgay = CInt(Trai)
Else
DongNgay = CInt(0)
End If
'Xac dinh lech ngay va ky tu:
LechNgay = 0
TachKyTu = ""
ElseIf ViTriBD > 0 Then
'Xac dinh dong ngay:
Trai = Left(DuLieuViTri, ViTriBD - 1)
If IsNumeric(Trai) = True Then
DongNgay = CInt(Trai)
Else
DongNgay = CInt(0)
End If
'Xac dinh lech ngay:
Phai = Right(DuLieuViTri, Len(DuLieuViTri) - ViTriKT + 1)
If IsNumeric(Phai) = True Then
LechNgay = CInt(Phai)
Else
LechNgay = CInt(0)
End If
'Xac dinh ky tu:
KyTu = Replace(CellDL.Value, DongNgay, "")
KyTu = Replace(KyTu, LechNgay, "")
KyTu = Replace(KyTu, "+", "")
KyTu = Replace(KyTu, "-", "")
KyTu = Replace(KyTu, "/", "")
If IsNumeric(KyTu) = False Then
TachKyTu = KyTu
Else
TachKyTu = ""
End If
End If

'Gan ket qua ra cell:
If DongNgay > 0 Then
Khoang = i - DongNgay

'Xac dinh ngay BatDau:
If TachKyTu = "" Then
If CellDL.Offset(-Khoang, -1).Value > 0 Then
BatDau = CellDL.Offset(-Khoang, -1).Value + 1
Else
BatDau = 0
End If
If CellDL.Offset(0, -3).Value > 0 And BatDau > 0 Then
KetThuc = CellDL.Offset(0, -3).Value + BatDau - 1
ElseIf CellDL.Offset(0, -3).Value = 0 Then
KetThuc = BatDau
Else
KetThuc = 0
End If
End If
If TachKyTu = KyTuBatDau & KyTuBatDau Then
If CellDL.Offset(-Khoang, -2).Value > 0 Then
BatDau = CellDL.Offset(-Khoang, -2).Value + LechNgay
Else
BatDau = 0
End If
If CellDL.Offset(0, -3).Value > 0 And BatDau > 0 Then
KetThuc = CellDL.Offset(0, -3).Value + BatDau - 1
ElseIf CellDL.Offset(0, -3).Value = 0 Then
KetThuc = BatDau
Else
KetThuc = 0
End If
End If
If TachKyTu = KyTuKetThuc & KyTuBatDau Then
If CellDL.Offset(-Khoang, -1).Value > 0 Then
BatDau = CellDL.Offset(-Khoang, -1).Value + LechNgay + 1
Else
BatDau = 0
End If
If CellDL.Offset(0, -3).Value > 0 And BatDau > 0 Then
KetThuc = CellDL.Offset(0, -3).Value + BatDau - 1
ElseIf CellDL.Offset(0, -3).Value = 0 Then
KetThuc = BatDau
Else
KetThuc = 0
End If
End If

'Xac dinh ngay KetThuc:
If TachKyTu = KyTuKetThuc & KyTuKetThuc Then
If CellDL.Offset(-Khoang, -1).Value > 0 Then
KetThuc = CellDL.Offset(-Khoang, -1).Value + LechNgay
Else
KetThuc = 0
End If
If CellDL.Offset(0, -3).Value > 0 And KetThuc > 0 Then
BatDau = KetThuc - CellDL.Offset(0, -3).Value + 1
ElseIf CellDL.Offset(0, -3).Value = 0 Then
BatDau = KetThuc
Else
BatDau = 0
End If
End If
If TachKyTu = KyTuBatDau & KyTuKetThuc Then
If CellDL.Offset(-Khoang, -2).Value > 0 Then
KetThuc = CellDL.Offset(-Khoang, -2).Value + LechNgay
Else
KetThuc = 0
End If
If CellDL.Offset(0, -3).Value > 0 And KetThuc > 0 Then
BatDau = KetThuc - CellDL.Offset(0, -3).Value + 1
ElseIf CellDL.Offset(0, -3).Value = 0 Then
BatDau = KetThuc
Else
BatDau = 0
End If
End If

'So sanh voi ngay nghi:
If NghiBD1 * NghiKT1 > 0 Then
If BatDau >= NghiBD1 And BatDau <= NghiKT1 Then
BatDau = NghiKT1
ElseIf BatDau < NghiBD1 And KetThuc >= NghiBD1 Then
KetThuc = KetThuc + NghiKT1 - NghiBD1
End If
End If


'Lay ket qua:
If BatDau > 0 Then
CellDL.Offset(0, -2).Value = BatDau
CellDL.Offset(0, -2).NumberFormat = "dd/mm/yyyy"
Else
CellDL.Offset(0, -2).Value = ""
End If
If KetThuc > 0 Then
CellDL.Offset(0, -1).Value = KetThuc
CellDL.Offset(0, -1).NumberFormat = "dd/mm/yyyy"
Else
CellDL.Offset(0, -1).Value = ""
End If

'To mau cho cac o co gia tri chua xac dinh:
If CellDL.Offset(-Khoang, -2).Value = 0 Or CellDL.Offset(-Khoang, -1).Value = 0 Then
CellDL.Font.ColorIndex = 3
Else
CellDL.Font.ColorIndex = 0
End If
End If
ElseIf CellDL.Value = "" And CellDL.Offset(0, -1).Value <> "" And CellDL.Offset(0, -3).Value <> "" Then
CellDL.Offset(0, -2).Value = CellDL.Offset(0, -1).Value - CellDL.Offset(0, -3).Value + 1
ElseIf CellDL.Value = "" And CellDL.Offset(0, -2).Value <> "" And CellDL.Offset(0, -3).Value <> "" Then
CellDL.Offset(0, -1).Value = CellDL.Offset(0, -2).Value + CellDL.Offset(0, -3).Value - 1
End If
Next i
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Maika8008]

Bạn đưa code vào trong thẻ CODE chứ để vậy ai đọc nổi

 

[tuan16]

Bạn đưa code vào trong thẻ CODE chứ để vậy ai đọc nổi

Dạ vâng. Em xin gửi file lên ạ. Nhờ bác giúp em với ạ

 

[Maika8008]

Không hiểu được ý đồ của code và khâu chuẩn bị dữ liệu để chạy code thì chịu, không thể bổ sung cái gì vào được