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

Liên hệ QC
B

Bích Tỷ

Thành viên chính thức
Tham gia
17/5/21
Bài viết
79
Được thích
19
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.
 

File đính kèm

  • tính tổng phép.xlsb
    100.7 KB · Đọc: 17
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Kết quả ghi vô đâu vậy bạn, hay ghi lên diễn đàn (?)
 
Upvote 0
Bích Tỷ đã viết:
, 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.
Nhấp chuột vào đây để mở rộng...
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!
 
Upvote 0
CHAOQUAY đã viết:
Cái chỗ " lm" này là viết thay cho từ gì thế bạn
Nhấp chuột vào đây để mở rộng...
bàn phím bị kẹt anh ơi. hi
Bài đã được tự động gộp:

SA_DQ đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
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"))

PHP: 
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
Mã: 
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
 
Lần chỉnh sửa cuối:
Upvote 0
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.
 
Lần chỉnh sửa cuối:
Upvote 0
SA_DQ đã viế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.
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • tính tổng phép.xlsb
    110.9 KB · Đọc: 10
Lần chỉnh sửa cuối:
Upvote 0
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?
 
Upvote 0
SA_DQ đã viế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?
Nhấp chuột vào đây để mở rộng...
Dạ, đúng rồi anh. chỉ trả kết quả về 1 cột O thôi anh.
 
Upvote 0
Bạn chép thêm macro này vô module hiện có & đừng xóa hàm tự tạo nha:
PHP: 
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!
 
Lần chỉnh sửa cuối:
Upvote 0
SA_DQ đã viết:
Bạn chép thêm macro này vô module hiện có & đừng xóa hàm tự tạo nha:
PHP: 
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!
Nhấp chuột vào đây để mở rộng...
Dạ, em chân thành cảm ơn anh. Thật tuyệt
 
Upvote 0
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.
 

File đính kèm

  • 205.jpg
    205.jpg
    60.9 KB · Đọc: 2
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

8
Hàm thống kê số lượng thành viên câu lạc bộ theo từng đợt tuyển thành viên
Trả lời
1
Đọc
30
SA_DQ
SA_DQ
S
Nhờ hỗ trợ code tìm kiếm dữ liệu bằng hộp tìm kiếm
Trả lời
9
Đọc
168
S.Ha
S
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
Trả lời
7
Đọc
922
quangminhici
quangminhici
S
Cần giúp đỡ hàm đếm
Trả lời
10
Đọc
183
Phan Thế Hiệp
Phan Thế Hiệp
PhiTQ-ME
  • Question
Nhờ trợ giúp sửa VBA tính diễn giải khối lượng
Trả lời
2
Đọc
65
PhiTQ-ME
PhiTQ-ME
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom