Tính tổng số ngày nghỉ phép VBA

[Bích Tỷ]

Dạ, em xin chào các anh chị, em có một file bảng tính giờ công, em nhờ các anh chị giúp em tính với ạ. Với điều kiện và kết qua như sau.
Tính tổng số ngày nghỉ phép (RP+PB)

Điều kiện:

• Đối với cột WORK QTYS là 0 & <7 và cột WORK NO = cột danh sách ở (SHEETS data), Cột HOLIDAY KIND phải bằng: RP/PB
• kết quả là: 8 - WORK QTYS
• Đối với WORK QTYS là 0 & <8 và WORK NO <> cột danh sách ở (SHEETS data), Cột HOLIDAY KIND phải bằng: RP/PB
• kết quả là 8 - WORK QTYS

em xin chân thành cảm ơn.

 

[SA_DQ]

Kết quả ghi vô đâu vậy bạn, hay ghi lên diễn đàn (?)

 

[Bích Tỷ]

Kết quả ghi vô đâu vậy bạn, hay ghi lên diễn đàn (?)

dạ, kết quá mẫu ở cột O7 á anh, em làm sẵn bằng tay một số người, vì dữ liệu công ty nên em chỉ làm mẫu nhiêu đó anh. mong anh giúp đỡ. cảm ơn anh

 

[CHAOQUAY]

dạ, kết quá mẫu ở cột O7 á anh, em lm sẵn bằng tay một số người, vì dữ liệu công ty nên em chỉ làm mẫu nhiêu đó anh. mong anh giúp đỡ. cảm ơn anh

Cái chỗ " lm" này là viết thay cho từ gì thế bạn

 

[SA_DQ]

, Cột HOLIDAY KIND phải bằng: RP/PB
, Cột HOLIDAY KIND phải bằng: RP/PB

em xin chân thành cảm ơn.

Cái cột mà mình trích dẫn chỉ có độ dài là 0 hay 2 kí tự; Chứ có khi nào đủ 5 kí tự (RP/PB) đâu cơ chứ!
Bạn phải biết rằng sai 1 li đi 1 dặm đó nghe!

 

[Bích Tỷ]

Cái chỗ " lm" này là viết thay cho từ gì thế bạn

bàn phím bị kẹt anh ơi. hi

Bài đã được tự động gộp: 17/5/21

Cái cột mà mình trích dẫn chỉ có độ dài là 0 hay 2 kí tự; Chứ có khi nào đủ 5 kí tự (RP/PB) đâu cơ chứ!
Bạn phải biết rằng sai 1 li đi 1 dặm đó nghe!

dạ, ý của yêu cầu là 1 ngày nghỉ 1 loại phép, và 1 tuần sẽ có nhiều loại phép khác nhau á anh, yêu cầu là tính tổng số giờ RP và PB trong một tuần á anh

 

[SA_DQ]

Bạn thử với macro này; Còn 1 (mới sửa lại) nhân vật cuối đang sai; Bạn giúp tìm nguyên nhân cái nha:
Lưu ý: Vùng có dữ liệu của trang 'Data' được gán tên là 'BTr' (Câu lệnh: Sheets("Data").Range("BTr"))

Sub TinhNgayFepTheoDieuKien()
 Dim Rws As Long, J As Long, W As Integer, MaNV As Double, Tong As Double
 Dim Arr(), Rng As Range, sRng As Range
 Dim LoaiNghi As String, WNo As String
 ReDim aKQ(1 To 99, 5 To 15)
 
 With Sheets("ERP")
    Rws = .[B4].CurrentRegion.Rows.Count
    Arr() = .[A4].Resize(Rws, 25).Value
    For J = 1 To UBound(Arr())
        If Arr(J, 1) <> MaNV Then
            If J > 1 Then
                W = W + 1:          aKQ(W, 5) = MaNV
                aKQ(W, 15) = Tong:  Tong = 0
            Else
            End If
            MaNV = Arr(J, 1)
        End If
        LoaiNghi = Arr(J, 24)
        WNo = Arr(J, 3)
        If LoaiNghi = "RP" Or LoaiNghi = "PB" Then
            If W_No(WNo) And Arr(J, 13) < 7 Then
                Tong = Tong + 8 - Arr(J, 13)
            ElseIf Not W_No(WNo) And Arr(J, 13) < 8 Then  'Mới sửa lại   '
                Tong = Tong + 8 - Arr(J, 13)
            End If
        End If
    Next J
 End With
 If W Then
    Sheets("W1").[E7].Resize(W, 11).Value = aKQ()
 End If
End Sub

Function W_No(WNo As String) As Boolean
 Dim Rng As Range, sRng As Range
 
 Set Rng = Sheets("Data").Range("BTr")  '** ** **'
 Set sRng = Rng.Find(WNo, , xlFormulas, xlWhole)
 W_No = Not sRng Is Nothing
End Function

 

[SA_DQ]

Mình vừa sửa lại câu lệnh
ElseIf Not W_No(WNo) And Arr(J, 13) < 8 Then
& chỉ còn tính sai của người cuối cùng; Bạn xem lại giúp mình nha.

 

[Bích Tỷ]

Mình vừa sửa lại câu lệnh
ElseIf Not W_No(WNo) And Arr(J, 13) < 8 Then
& chỉ còn tính sai của người cuối cùng; Bạn xem lại giúp mình nha.

Dạ, em xem và thử kết quả ạ. Cảm ơn anh. Nếu có vấn đề gì em phản hồi ạ.

 

[Bích Tỷ]

Mình vừa sửa lại câu lệnh
ElseIf Not W_No(WNo) And Arr(J, 13) < 8 Then
& chỉ còn tính sai của người cuối cùng; Bạn xem lại giúp mình nha.

dạ, chào anh.
sau khi em chạy thử thì kết quả trả về đúng nhưng:
+ phần dữ liệu từ cột F đến cột N thì lại mất hết anh ơi (Riêng đối với cột E thì giữ nguyên trạng thái dữ liệu ban đầu được không anh).
+ Chỉ trả về kết quả những số thẻ cho trong sheet w1 chứ không lấy hết toàn bộ số thẻ trong sheet ERP, vì số thẻ là điều kiện chứ không phải coppy từ ERP qua. (Hiện tại code lấy hết số thẻ từ ERP sang W1 á anh).
anh chỉnh lại phần này giúp em với ạ cảm ơn anh.
VD: cột E có số thẻ là: ''17984 sau khi chạy kết quả xong là ''17984, số thẻ bị mất dấu' á anh. e muốn giữ nguyên số thẻ như ban đầu luôn anh

 

[SA_DQ]

Hiện tại thì duyệt toàn bộ dữ liệu bên trang 'ERP'; dòng nào thỏa điều kiện thì đem sang;
Nếu muốn chỉ đưa ra kết quả cho những người có trong trang 'W1' thì cần sửa lại macro
& cái macro sửa lại này chỉ trả kết quả trên 01 cột mà bạn cần thôi, phải không?

 

[Bích Tỷ]

Hiện tại thì duyệt toàn bộ dữ liệu bên trang 'ERP'; dòng nào thỏa điều kiện thì đem sang;
Nếu muốn chỉ đưa ra kết quả cho những người có trong trang 'W1' thì cần sửa lại macro
& cái macro sửa lại này chỉ trả kết quả trên 01 cột mà bạn cần thôi, phải không?

Dạ, đúng rồi anh. chỉ trả kết quả về 1 cột O thôi anh.

 

[SA_DQ]

Bạn chép thêm macro này vô module hiện có & đừng xóa hàm tự tạo nha:

Sub TinhNghiTheoDanhSachDaCo()
 Dim Rws As Long, lRw As Integer, Dg As Integer, MaNV As Double, J As Long, W As Integer
 Dim Arr(), Tong As Double, MyColor As Byte
 Dim LoaiNghi As String, WNo As String
 
 Sheets("W1").Select
 lRw = [e65500].End(xlUp).Row
 If lRw < 7 Then
    MsgBox "Nothing!", , "GPE.COM":         Exit Sub
 Else:                      Randomize:
 End If
 ReDim aKQ(1 To lRw, 1 To 1) As Double
 
 With Sheets("ERP")
    Rws = .[B4].CurrentRegion.Rows.Count
    Arr() = .[A4].Resize(Rws, 25).Value     '25  '
 End With
 For Dg = 7 To lRw
    MaNV = Cells(Dg, "E").Value
    W = W + 1
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = MaNV Then
            LoaiNghi = Arr(J, 24)
            WNo = Arr(J, 3)
           
            If LoaiNghi = "RP" Or LoaiNghi = "PB" Then
                If W_No(WNo) And Arr(J, 13) < 7 Then
                    Tong = Tong + 8 - Arr(J, 13)
                ElseIf Not W_No(WNo) And Arr(J, 13) < 8 Then
                    Tong = Tong + 8 - Arr(J, 13)
                End If
            End If
        End If
    Next J
    aKQ(W, 1) = Tong:                   Tong = 0
 Next Dg
 MyColor = 34 + 9 * Rnd() \ 1
 If W Then
    [O7].Resize(W).Value = aKQ():       [E5:F5].Interior.ColorIndex = MyColor
 End If
 MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
End Sub

Chúc vui!

 

[Bích Tỷ]

Bạn chép thêm macro này vô module hiện có & đừng xóa hàm tự tạo nha:

Sub TinhNghiTheoDanhSachDaCo()
 Dim Rws As Long, lRw As Integer, Dg As Integer, MaNV As Double, J As Long, W As Integer
 Dim Arr(), Tong As Double, MyColor As Byte
 Dim LoaiNghi As String, WNo As String
 
 Sheets("W1").Select
 lRw = [e65500].End(xlUp).Row
 If lRw < 7 Then
    MsgBox "Nothing!", , "GPE.COM":         Exit Sub
 Else:                      Randomize:
 End If
 ReDim aKQ(1 To lRw, 1 To 1) As Double
 
 With Sheets("ERP")
    Rws = .[B4].CurrentRegion.Rows.Count
    Arr() = .[A4].Resize(Rws, 25).Value     '25  '
 End With
 For Dg = 7 To lRw
    MaNV = Cells(Dg, "E").Value
    W = W + 1
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = MaNV Then
            LoaiNghi = Arr(J, 24)
            WNo = Arr(J, 3)
          
            If LoaiNghi = "RP" Or LoaiNghi = "PB" Then
                If W_No(WNo) And Arr(J, 13) < 7 Then
                    Tong = Tong + 8 - Arr(J, 13)
                ElseIf Not W_No(WNo) And Arr(J, 13) < 8 Then
                    Tong = Tong + 8 - Arr(J, 13)
                End If
            End If
        End If
    Next J
    aKQ(W, 1) = Tong:                   Tong = 0
 Next Dg
 MyColor = 34 + 9 * Rnd() \ 1
 If W Then
    [O7].Resize(W).Value = aKQ():       [E5:F5].Interior.ColorIndex = MyColor
 End If
 MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
End Sub

Chúc vui!

Dạ, em chân thành cảm ơn anh. Thật tuyệt

 

[TrờivàothuViNamđẹplắmemơi]

Xin chào các bạn, xin hãy giúp tôi rút gọn công thức tính phép năm này với.

 

[SA_DQ]

Vì iêu cầu của bạn về 'công thức' nên bài của bạn không ăn nhập gì với lập trình: Nên Bài đăng trở thành xen ngang!

Bạn nên tạo dựng 1 bài đăng mới toanh để được trả lời theo đúng qui định.