Nhờ sửa Code file "Chamcong_luong" (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
tommybull

tommybull

Thành viên hoạt động
Tham gia
21/7/08
Bài viết
191
Được thích
29
Giới tính
Nam
Kính chào các anh chị trên GPE, lần trước đã nhờ các anh chị làm giúp File "Chamcong_luong"
Sau khi thực hiện, em gặp một số vấn đề và cần chỉnh sửa lại cho phù hợp, Kính mong anh chị giúp đỡ
File em gửi đính kèm, cần chỉnh sửa lại như sau ạ:

1. Tại Sheet "Chamcong" , Sửa lại code Update_list sao cho danh sách nhân viên chuyển từ Sheet "Danhsach_NV" vào Sheet "Chamcong", trừ những người em đã đánh ngày thôi việc tại cột "V" của Sheet "Danhsach-NV", đồng thời tự động đánh dấu "X" vào các ô từ "F đến AJ" trừ những ngày chủ nhật là không đánh dấu "X"
*** Code chấm công hiện tại đang dùng, mỗi đơn vị số tương ứng với 0.5 giờ, ví dụ "P3" nghỉ phép năm 1,5 tiếng,
Em muốn chỉnh lại theo số thực tế: Ví dự: P4: Nghỉ phép năm 4 tiếng, V4.5: Nghỉ việc riêng 4,5 tiếng

2. Các cột "Vắng mặt" (các loại phép) và các cột ghi các loại tăng ca (Từ AK đến AY) em có ghi chú ví dụ cho minh họa cho nhân viên HA1709004, anh chị sửa lại Code giúp ạ

3. Phần Code "Kết xuất" bảng chấm công sau khi kết xuất thì Ô AI4 không kết xuất được, anh chị chỉnh sửa giúp ạ

4. Do Sheet Payroll_luong, phải chi dòng để phân biệt chi phí quản lý và chi phí nhân công trực tiếp cho bộ phận kế toán theo dõi, nên khi chạy lệnh "Update_List" bị báo lỗi, anh chị sửa lại giúp ạ!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
@ Chủ thớt:
(Hôm qua đã cố không viết vì tưởng chủ thớt đã hiểu "tâm tư").
Bạn may mắn là gặp anh Hiếu xem giúp bài của bạn, nên cái thớt này mới kéo dài hơn 60 bài...

Thông thường, sau khoảng 2-3 cái "nhưng mà còn" thì mọi người đã cao chạy xa bay.
Không ai có đủ sức để chạy theo những ý tưởng mỗi lúc một khác của quý vị được.
Bước viết code là bước cuối cùng, lúc đó không còn cái ý tưởng nào nữa. Quan trọng hơn cả là việc xây dựng cấu trúc dữ liệu và làm trước tiên.

"Nhưng mà còn... Nếu thế này thế kia..." gọi là dắt mũi. Không tin bạn thử đổi vị trí hỏi - trả lời xem...
 
Upvote 0
befaint đã viết:
@ Chủ thớt:
(Hôm qua đã cố không viết vì tưởng chủ thớt đã hiểu "tâm tư").
Bạn may mắn là gặp anh Hiếu xem giúp bài của bạn, nên cái thớt này mới kéo dài hơn 60 bài...

Thông thường, sau khoảng 2-3 cái "nhưng mà còn" thì mọi người đã cao chạy xa bay.
Không ai có đủ sức để chạy theo những ý tưởng mỗi lúc một khác của quý vị được.
Bước viết code là bước cuối cùng, lúc đó không còn cái ý tưởng nào nữa. Quan trọng hơn cả là việc xây dựng cấu trúc dữ liệu và làm trước tiên.

"Nhưng mà còn... Nếu thế này thế kia..." gọi là dắt mũi. Không tin bạn thử đổi vị trí hỏi - trả lời xem...
Nhấp chuột vào đây để mở rộng...
Dạ. Em biết rồi ạ. Sẽ rút kinh nghiem lần sau. Thật là may mắn được các anh chị luôn quan tâm và đặc biệt là anh "HieuCD" đã nhiệt tình giúp đỡ trong bài này.
Giờ thì về cấu trúc file đã ổn rồi ạ! Em đang sử dụng nếu có vấn đề lại sẽ phiền anh chị giúp đỡ ( nhưng chắc chắn là không sửa cấu trúc "hàng- cột" của file nữa đâu ạ)
Chúc cả nhà buổi tối an lành
 
Upvote 0
HieuCD đã viết:
Kiểm tra file
Nhấp chuột vào đây để mở rộng...
Chào anh Hiếu, em gửi lại File nhờ anh xem giúp ạ,
1. Tại Sheet "Chamcong" Khi chạy lệnh Kết xuất File, thì tại "AI4" không kết xuất ra số giá trị Value mà chỉ toàn là dấu "#####" anh giúp em điều chỉnh lại ạ!

2. Sheet "Chamcong" Sau khi em chấm công và kiểm tra từ "F:AJ" thì bị hiện tượng (Gần như lặp lại theo chu kỳ) tại những ô em tô màu vàng và màu đỏ như sau:
+++ Tại ô màu vàng em chấm công 3 tiếng tăng ca thì tại cột "AU" có thể hiện chính xác số giờ, nhưng cột "BB" lại thể hiện là 2 (trong khi theo điều kiện là chỉ thể hiện 1)
+++ Tại ô màu đỏ, em chấm công 3 tiếng tăng ca thì tại cột "AU" không thể hiện số giờ tăng ca và tại cột "BB" cũng không thể hiện số tương ứng (là 1 "hưởng 1 bữa ăn giữa ca")

3. Sheet "Payrol_Luong" khi em chạy lện 'Kết xuất lương" thì chỉ có một số dòng và cột chuyển dữ liệu thành giá trị "Value" còn lại thì công thức vẫn chạy qua theo, anh giúp em cho chuyển tòan bộ thành giá trị "value" ở File được kết xuất ạ!
Các vấn đề trên, anh làm ơn xem giúp em nhé. em cần lắm ạ!
Cảm ơn anh nhiều!
Trân trọng!
 

File đính kèm

Upvote 0
tommybull đã viết:
Chào anh Hiếu, em gửi lại File nhờ anh xem giúp ạ,
1. Tại Sheet "Chamcong" Khi chạy lệnh Kết xuất File, thì tại "AI4" không kết xuất ra số giá trị Value mà chỉ toàn là dấu "#####" anh giúp em điều chỉnh lại ạ!

2. Sheet "Chamcong" Sau khi em chấm công và kiểm tra từ "F:AJ" thì bị hiện tượng (Gần như lặp lại theo chu kỳ) tại những ô em tô màu vàng và màu đỏ như sau:
+++ Tại ô màu vàng em chấm công 3 tiếng tăng ca thì tại cột "AU" có thể hiện chính xác số giờ, nhưng cột "BB" lại thể hiện là 2 (trong khi theo điều kiện là chỉ thể hiện 1)
+++ Tại ô màu đỏ, em chấm công 3 tiếng tăng ca thì tại cột "AU" không thể hiện số giờ tăng ca và tại cột "BB" cũng không thể hiện số tương ứng (là 1 "hưởng 1 bữa ăn giữa ca")

3. Sheet "Payrol_Luong" khi em chạy lện 'Kết xuất lương" thì chỉ có một số dòng và cột chuyển dữ liệu thành giá trị "Value" còn lại thì công thức vẫn chạy qua theo, anh giúp em cho chuyển tòan bộ thành giá trị "value" ở File được kết xuất ạ!
Các vấn đề trên, anh làm ơn xem giúp em nhé. em cần lắm ạ!
Cảm ơn anh nhiều!
Trân trọng!
Nhấp chuột vào đây để mở rộng...
1. Tại Sheet "Chamcong" Khi chạy lệnh Kết xuất File và 3. Sheet "Payrol_Luong" khi em chạy lện 'Kết xuất lương": Đâu biết bạn muốn làm gì mà chỉnh, bạn nên nhờ người viết code chỉnh lại
2. Ô màu đỏ không có làm việc sao lại tăng ca?
Ô màu vàng sai do mình viết thiếu 1 dòng lệnh: t=0
Mã: 
Sub Tinh_Cong()
    Dim sArr, dArr, cArr, pArr, S, tmp
    Dim I As Long, j As Long, lR As Long, k As Long, n As Long, jk As Long, vm As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("Chamcong")
      lR = .Range("C65535").End(xlUp).Row
      If lR > 5 Then
        pArr = .Range("AK5:AR5").Value
        sArr = .Range("F6:AJ" & lR).Resize(, 31).Value
        ReDim dArr(1 To UBound(sArr), 1 To 10)
        ReDim cArr(1 To UBound(sArr), 1 To 8)
        For I = 1 To UBound(sArr) Step 7
          For j = 1 To 31
            If sArr(I, j) <> "" Then
              dArr(I, 9) = dArr(I, 9) + 8
              If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) + 8
              cArr(I, 7) = cArr(I, 7) + 1
             
              S = Split(sArr(I, j) & ";X", ";")
              For n = LBound(S) To UBound(S)
                tmp = UCase(S(n))
                If InStr(tmp, "X") = 0 Then
                  t = 0
                  For jk = 1 To 8
                    If InStr(tmp, pArr(1, jk)) Then
                      If Replace(tmp, pArr(1, jk), "") = "" Then vm = 8 Else vm = CDbl(Replace(tmp, pArr(1, jk), ""))
                      dArr(I, jk) = dArr(I, jk) + vm
                      t = t + vm
                      If jk > 2 Then
                        dArr(I, 9) = dArr(I, 9) - vm
                        If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) - vm
                      End If
                    End If
                  Next jk
                  If t > 4 Then cArr(I, 7) = cArr(I, 7) - 1
                End If
              Next n
             
              t = 0
              For k = 1 To 2 'Tang ca ngay thuong
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            Else
              t = 0
              For k = 3 To 6 'Tang ca ngay le, Chu nhat
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            End If
          Next j
        Next I
      End If
      .Range("AK6").Resize(UBound(dArr), 10) = dArr
      .Range("AU6").Resize(UBound(dArr), 8) = cArr
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
HieuCD đã viết:
1. Tại Sheet "Chamcong" Khi chạy lệnh Kết xuất File và 3. Sheet "Payrol_Luong" khi em chạy lện 'Kết xuất lương": Đâu biết bạn muốn làm gì mà chỉnh, bạn nên nhờ người viết code chỉnh lại
2. Ô màu đỏ không có làm việc sao lại tăng ca?
Ô màu vàng sai do mình viết thiếu 1 dòng lệnh: t=0
Mã: 
Sub Tinh_Cong()
    Dim sArr, dArr, cArr, pArr, S, tmp
    Dim I As Long, j As Long, lR As Long, k As Long, n As Long, jk As Long, vm As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("Chamcong")
      lR = .Range("C65535").End(xlUp).Row
      If lR > 5 Then
        pArr = .Range("AK5:AR5").Value
        sArr = .Range("F6:AJ" & lR).Resize(, 31).Value
        ReDim dArr(1 To UBound(sArr), 1 To 10)
        ReDim cArr(1 To UBound(sArr), 1 To 8)
        For I = 1 To UBound(sArr) Step 7
          For j = 1 To 31
            If sArr(I, j) <> "" Then
              dArr(I, 9) = dArr(I, 9) + 8
              If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) + 8
              cArr(I, 7) = cArr(I, 7) + 1
            
              S = Split(sArr(I, j) & ";X", ";")
              For n = LBound(S) To UBound(S)
                tmp = UCase(S(n))
                If InStr(tmp, "X") = 0 Then
                  t = 0
                  For jk = 1 To 8
                    If InStr(tmp, pArr(1, jk)) Then
                      If Replace(tmp, pArr(1, jk), "") = "" Then vm = 8 Else vm = CDbl(Replace(tmp, pArr(1, jk), ""))
                      dArr(I, jk) = dArr(I, jk) + vm
                      t = t + vm
                      If jk > 2 Then
                        dArr(I, 9) = dArr(I, 9) - vm
                        If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) - vm
                      End If
                    End If
                  Next jk
                  If t > 4 Then cArr(I, 7) = cArr(I, 7) - 1
                End If
              Next n
            
              t = 0
              For k = 1 To 2 'Tang ca ngay thuong
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            Else
              t = 0
              For k = 3 To 6 'Tang ca ngay le, Chu nhat
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            End If
          Next j
        Next I
      End If
      .Range("AK6").Resize(UBound(dArr), 10) = dArr
      .Range("AU6").Resize(UBound(dArr), 8) = cArr
    End With
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ. Em Coppy Code về và chạy ổn rồi ạk!
Chúc anh buổi tối an lành
Cảm ơn anh nhiều ạk!
 
Upvote 0
HieuCD đã viết:
1. Tại Sheet "Chamcong" Khi chạy lệnh Kết xuất File và 3. Sheet "Payrol_Luong" khi em chạy lện 'Kết xuất lương": Đâu biết bạn muốn làm gì mà chỉnh, bạn nên nhờ người viết code chỉnh lại
2. Ô màu đỏ không có làm việc sao lại tăng ca?
Ô màu vàng sai do mình viết thiếu 1 dòng lệnh: t=0
Mã: 
Sub Tinh_Cong()
    Dim sArr, dArr, cArr, pArr, S, tmp
    Dim I As Long, j As Long, lR As Long, k As Long, n As Long, jk As Long, vm As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("Chamcong")
      lR = .Range("C65535").End(xlUp).Row
      If lR > 5 Then
        pArr = .Range("AK5:AR5").Value
        sArr = .Range("F6:AJ" & lR).Resize(, 31).Value
        ReDim dArr(1 To UBound(sArr), 1 To 10)
        ReDim cArr(1 To UBound(sArr), 1 To 8)
        For I = 1 To UBound(sArr) Step 7
          For j = 1 To 31
            If sArr(I, j) <> "" Then
              dArr(I, 9) = dArr(I, 9) + 8
              If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) + 8
              cArr(I, 7) = cArr(I, 7) + 1
            
              S = Split(sArr(I, j) & ";X", ";")
              For n = LBound(S) To UBound(S)
                tmp = UCase(S(n))
                If InStr(tmp, "X") = 0 Then
                  t = 0
                  For jk = 1 To 8
                    If InStr(tmp, pArr(1, jk)) Then
                      If Replace(tmp, pArr(1, jk), "") = "" Then vm = 8 Else vm = CDbl(Replace(tmp, pArr(1, jk), ""))
                      dArr(I, jk) = dArr(I, jk) + vm
                      t = t + vm
                      If jk > 2 Then
                        dArr(I, 9) = dArr(I, 9) - vm
                        If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) - vm
                      End If
                    End If
                  Next jk
                  If t > 4 Then cArr(I, 7) = cArr(I, 7) - 1
                End If
              Next n
            
              t = 0
              For k = 1 To 2 'Tang ca ngay thuong
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            Else
              t = 0
              For k = 3 To 6 'Tang ca ngay le, Chu nhat
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            End If
          Next j
        Next I
      End If
      .Range("AK6").Resize(UBound(dArr), 10) = dArr
      .Range("AU6").Resize(UBound(dArr), 8) = cArr
    End With
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Anh Hiếu ơi, Thực sự xin lỗi vì em không có ý "cẩu thả" hay gì gì đâu, nhưng giờ em mới lại phát hiện một vấn đề
Anh làm ơn giúp em ạ!
Vì công ty em trong một tháng được nghỉ 2 thứ 7 (một tháng làm 24 ngày), nên nếu có người nào đó đi làm đủ cả 4 thứ 7 thì ngẫu nhiên em phải chọn 2 thứ 7 bất kỳ trong tháng để tính "tăng ca thường", nhưng theo điều kiện hiện tại thì phải đánh dấu "X" (nghĩa là có đi làm) thì mới tính được số giờ tăng ca, mà như vậy thì số giờ thực tế lại bị sai lệch, mà không đánh dấu "X" (có đi làm) thì không tính được giờ tăng ca. Anh giúp em chỉnh lại Code để khi em chon 2 ngày thứ 7 bất kỳ để chấm tăng ca mà không cần đánh dấu "X" thì vẫn tính được giờ tăng ca ạ!
Xin cảm ơn anh!
 
Upvote 0
tommybull đã viết:
Anh Hiếu ơi, Thực sự xin lỗi vì em không có ý "cẩu thả" hay gì gì đâu, nhưng giờ em mới lại phát hiện một vấn đề
Anh làm ơn giúp em ạ!
Vì công ty em trong một tháng được nghỉ 2 thứ 7 (một tháng làm 24 ngày), nên nếu có người nào đó đi làm đủ cả 4 thứ 7 thì ngẫu nhiên em phải chọn 2 thứ 7 bất kỳ trong tháng để tính "tăng ca thường", nhưng theo điều kiện hiện tại thì phải đánh dấu "X" (nghĩa là có đi làm) thì mới tính được số giờ tăng ca, mà như vậy thì số giờ thực tế lại bị sai lệch, mà không đánh dấu "X" (có đi làm) thì không tính được giờ tăng ca. Anh giúp em chỉnh lại Code để khi em chon 2 ngày thứ 7 bất kỳ để chấm tăng ca mà không cần đánh dấu "X" thì vẫn tính được giờ tăng ca ạ!
Xin cảm ơn anh!
Nhấp chuột vào đây để mở rộng...
Chào buổi sáng anh "HieuCD"
Anh làm ơn giúp em vấn đề nêu trên nhé
Xin lỗi vì làm phiền anh buổi sáng sớm ạ
Mong tin của anh!
 
Upvote 0
tommybull đã viết:
Chào buổi sáng anh "HieuCD"
Anh làm ơn giúp em vấn đề nêu trên nhé
Xin lỗi vì làm phiền anh buổi sáng sớm ạ
Mong tin của anh!
Nhấp chuột vào đây để mở rộng...
Chỉnh lại code
For k = 1 To 6 'Tang ca ngay le, Chu nhat
Chưa kiểm tra hết các khả năng
Mã: 
Sub Tinh_Cong()
    Dim sArr, dArr, cArr, pArr, S, tmp
    Dim I As Long, j As Long, lR As Long, k As Long, n As Long, jk As Long, vm As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("Chamcong")
      lR = .Range("C65535").End(xlUp).Row
      If lR > 5 Then
        pArr = .Range("AK5:AR5").Value
        sArr = .Range("F6:AJ" & lR).Resize(, 31).Value
        ReDim dArr(1 To UBound(sArr), 1 To 10)
        ReDim cArr(1 To UBound(sArr), 1 To 8)
        For I = 1 To UBound(sArr) Step 7
          For j = 1 To 31
            If sArr(I, j) <> "" Then
              dArr(I, 9) = dArr(I, 9) + 8
              If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) + 8
              cArr(I, 7) = cArr(I, 7) + 1
             
              S = Split(sArr(I, j) & ";X", ";")
              For n = LBound(S) To UBound(S)
                tmp = UCase(S(n))
                If InStr(tmp, "X") = 0 Then
                  t = 0
                  For jk = 1 To 8
                    If InStr(tmp, pArr(1, jk)) Then
                      If Replace(tmp, pArr(1, jk), "") = "" Then vm = 8 Else vm = CDbl(Replace(tmp, pArr(1, jk), ""))
                      dArr(I, jk) = dArr(I, jk) + vm
                      t = t + vm
                      If jk > 2 Then
                        dArr(I, 9) = dArr(I, 9) - vm
                        If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) - vm
                      End If
                    End If
                  Next jk
                  If t > 4 Then cArr(I, 7) = cArr(I, 7) - 1
                End If
              Next n
             
              t = 0
              For k = 1 To 2 'Tang ca ngay thuong
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            Else
              t = 0
              For k = 1 To 6 'Tang ca ngay le, Chu nhat
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            End If
          Next j
        Next I
      End If
      .Range("AK6").Resize(UBound(dArr), 10) = dArr
      .Range("AU6").Resize(UBound(dArr), 8) = cArr
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
HieuCD đã viết:
Chỉnh lại code
For k = 1 To 6 'Tang ca ngay le, Chu nhat
Chưa kiểm tra hết các khả năng
Mã: 
Sub Tinh_Cong()
    Dim sArr, dArr, cArr, pArr, S, tmp
    Dim I As Long, j As Long, lR As Long, k As Long, n As Long, jk As Long, vm As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("Chamcong")
      lR = .Range("C65535").End(xlUp).Row
      If lR > 5 Then
        pArr = .Range("AK5:AR5").Value
        sArr = .Range("F6:AJ" & lR).Resize(, 31).Value
        ReDim dArr(1 To UBound(sArr), 1 To 10)
        ReDim cArr(1 To UBound(sArr), 1 To 8)
        For I = 1 To UBound(sArr) Step 7
          For j = 1 To 31
            If sArr(I, j) <> "" Then
              dArr(I, 9) = dArr(I, 9) + 8
              If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) + 8
              cArr(I, 7) = cArr(I, 7) + 1
            
              S = Split(sArr(I, j) & ";X", ";")
              For n = LBound(S) To UBound(S)
                tmp = UCase(S(n))
                If InStr(tmp, "X") = 0 Then
                  t = 0
                  For jk = 1 To 8
                    If InStr(tmp, pArr(1, jk)) Then
                      If Replace(tmp, pArr(1, jk), "") = "" Then vm = 8 Else vm = CDbl(Replace(tmp, pArr(1, jk), ""))
                      dArr(I, jk) = dArr(I, jk) + vm
                      t = t + vm
                      If jk > 2 Then
                        dArr(I, 9) = dArr(I, 9) - vm
                        If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) - vm
                      End If
                    End If
                  Next jk
                  If t > 4 Then cArr(I, 7) = cArr(I, 7) - 1
                End If
              Next n
            
              t = 0
              For k = 1 To 2 'Tang ca ngay thuong
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            Else
              t = 0
              For k = 1 To 6 'Tang ca ngay le, Chu nhat
                cArr(I, k) = cArr(I, k) + sArr(I + k, j)
                t = t + sArr(I + k, j)
              Next k
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            End If
          Next j
        Next I
      End If
      .Range("AK6").Resize(UBound(dArr), 10) = dArr
      .Range("AU6").Resize(UBound(dArr), 8) = cArr
    End With
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ, em down về cho chạy rồi, chạy như vầy thì bảng tính không phân biệt giữa ngày thường và ngày chủ nhật, nhưng em nghĩ cũng không sao, mình hiểu và đánh đúng ô đúng dòng thì chấm công cũng chính xác rồi ạ, để em cho chạy tiếp xem còn vấn đề gì khác không ạ!
Cảm ơn anh!
 
Upvote 0
tommybull đã viết:
Dạ, em down về cho chạy rồi, chạy như vầy thì bảng tính không phân biệt giữa ngày thường và ngày chủ nhật, nhưng em nghĩ cũng không sao, mình hiểu và đánh đúng ô đúng dòng thì chấm công cũng chính xác rồi ạ, để em cho chạy tiếp xem còn vấn đề gì khác không ạ!
Cảm ơn anh!
Nhấp chuột vào đây để mở rộng...
Bạn gởi file với đầy đủ các trường hợp bạn chấm công, và kết quả mới biết bạn sẽ làm gì và yêu cầu ra sao, toàn đoán mò nên khó đúng ý
 
Upvote 0
HieuCD đã viết:
Bạn gởi file với đầy đủ các trường hợp bạn chấm công, và kết quả mới biết bạn sẽ làm gì và yêu cầu ra sao, toàn đoán mò nên khó đúng ý
Nhấp chuột vào đây để mở rộng...
Dạ, vậy để em soạn lại tất cả các trường hợp phát sinh trong bảng chấm công và kết quả cần nhận được, và gửi lại File cho anh
Nhờ anh giúp ạ
Chúc anh buổi sáng an lành!
Trân trọng!
 
Upvote 0
HieuCD đã viết:
Bạn gởi file với đầy đủ các trường hợp bạn chấm công, và kết quả mới biết bạn sẽ làm gì và yêu cầu ra sao, toàn đoán mò nên khó đúng ý
Nhấp chuột vào đây để mở rộng...
Chào anh, em gửi lại File có các trường hợp phát sinh khi chấm công của bên em (Em làm ví dụ cho 2 NV là "NU001" và "NU002" đồng thời em có ghi chú các vấn đề cần anh giúp đỡ giải quyết trong file luôn rồi ạ!
Với trường hợp hôm trước anh cho điều kiện là : "For k = 1 To 6 'Tang ca ngay le, Chu nhat" theo em thì tuy nó không phân biệt được ngày lễ hay ngày thường, nhưng em thấy không sao, chỉ cần mình đánh đúng cột dòng là được, nhưng cũng nhờ anh xem giúp còn phương án nào tối ưu hơn không ạ!
Mong nhận được sự giúp đỡ của anh
Chúc anh buổi chiều cuối tuần hạnh phúc vui vẻ
Trân trọng!
 

File đính kèm

Upvote 0
tommybull đã viết:
Chào anh, em gửi lại File có các trường hợp phát sinh khi chấm công của bên em (Em làm ví dụ cho 2 NV là "NU001" và "NU002" đồng thời em có ghi chú các vấn đề cần anh giúp đỡ giải quyết trong file luôn rồi ạ!
Với trường hợp hôm trước anh cho điều kiện là : "For k = 1 To 6 'Tang ca ngay le, Chu nhat" theo em thì tuy nó không phân biệt được ngày lễ hay ngày thường, nhưng em thấy không sao, chỉ cần mình đánh đúng cột dòng là được, nhưng cũng nhờ anh xem giúp còn phương án nào tối ưu hơn không ạ!
Mong nhận được sự giúp đỡ của anh
Chúc anh buổi chiều cuối tuần hạnh phúc vui vẻ
Trân trọng!
Nhấp chuột vào đây để mở rộng...
Chạy code
Mã: 
Sub Tinh_Cong()
    Dim sArr, dArr, cArr, pArr, S, tmp
    Dim I As Long, j As Long, lR As Long, k As Long, n As Long, jk As Long, vm As Double
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("Chamcong")
      lR = .Range("C65535").End(xlUp).Row
      If lR > 5 Then
        pArr = .Range("AK5:AR5").Value
        sArr = .Range("F6:AJ" & lR).Resize(, 31).Value
        ReDim dArr(1 To UBound(sArr), 1 To 10)
        ReDim cArr(1 To UBound(sArr), 1 To 8)
        For I = 1 To UBound(sArr) Step 7
          For j = 1 To 31
            If sArr(I, j) <> "" Then
              dArr(I, 9) = dArr(I, 9) + 8
              If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) + 8
              cArr(I, 7) = cArr(I, 7) + 1
             
              S = Split(sArr(I, j) & ";X", ";")
              For n = LBound(S) To UBound(S)
                tmp = UCase(S(n))
                If InStr(tmp, "X") = 0 Then
                  t = 0
                  For jk = 1 To 8
                    If InStr(tmp, pArr(1, jk)) Then
                      If Replace(tmp, pArr(1, jk), "") = "" Then vm = 8 Else vm = CDbl(Replace(tmp, pArr(1, jk), ""))
                      dArr(I, jk) = dArr(I, jk) + vm
                      t = t + vm
                      If jk > 2 Then
                        dArr(I, 9) = dArr(I, 9) - vm
                        If InStr(sArr(I, j), "D") Then dArr(I, 10) = dArr(I, 10) - vm
                      End If
                    End If
                  Next jk
                  If t > 4 Then cArr(I, 7) = cArr(I, 7) - 1
                End If
              Next n
            End If
             
            For k = 1 To 6
              cArr(I, k) = cArr(I, k) + sArr(I + k, j)
              t = 0
              t = t + sArr(I + k, j)
              If t >= 3 Then cArr(I, 8) = cArr(I, 8) + 1
            Next k
          Next j
        Next I
      End If
      .Range("AK6").Resize(UBound(dArr), 10) = dArr
      .Range("AU6").Resize(UBound(dArr), 8) = cArr
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Chúc anh "HieuCD" buổi tối cuối tuần vui vẻ
Em cho coppy code về rồi, để em cho chạy thử, nếu ổn hoặc nếu có vấn đề gì khác, em cũng sẽ báo cáo với anh ạ!
Chân thành cảm ơn anh
À...! em phải mời cafe đa tạ anh như thế nào đây ạ, là lời chân thành đấy ạ. anh mở lòng nhận lời em được không ạ!
Mong tin anh!
 
Upvote 0
tommybull đã viết:
Chúc anh "HieuCD" buổi tối cuối tuần vui vẻ
Em cho coppy code về rồi, để em cho chạy thử, nếu ổn hoặc nếu có vấn đề gì khác, em cũng sẽ báo cáo với anh ạ!
Chân thành cảm ơn anh
À...! em phải mời cafe đa tạ anh như thế nào đây ạ, là lời chân thành đấy ạ. anh mở lòng nhận lời em được không ạ!
Mong tin anh!
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn, giúp được bạn là mình vui rồi/-*+/
 
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

Manhhung90
Thoát chế độ Read only file word. Nhờ mọi người giúp ạ (1 người xem)
Trả lời
3
Đọc
40
Manhhung90
Manhhung90
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước. (1 người xem)
Trả lời
3
Đọc
68
hanhnguyen12022021
H
V
  • Question Question
Đếm xếp loại của đơn hàng (2 người xem)
Trả lời
4
Đọc
64
Hoàng Tuấn 868
H
N
Không chạy được file VBA
Trả lời
2
Đọc
78
hoangtuan.net
hoangtuan.net
H
Quản Lý Công Văn đi Và đến (2 người xem)
9 10 11
Trả lời
214
Đọc
158K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ (1 người xem)
Trả lời
3
Đọc
71
VetMini
V
S
RemoveDuplicates Adodb VBA
Trả lời
0
Đọc
65
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT (1 người xem)
Trả lời
0
Đọc
110
giaoluu1231
G
sangvanng92
  • Question Question
Phân quyền user truy cập (1 người xem)
Trả lời
9
Đọc
170
Hoàng Tuấn 868
H
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
7
Đọc
144
DinhManh1307
DinhManh1307
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
6
Đọc
302
tranhungdao12a3
T
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
Trả lời
0
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
befaint
Chia sẻ tâm tư, xả nỗi lòng
    • Thích
36 37 38
Trả lời
759
Đọc
49K
befaint
befaint
H
Quên mật khẩu khóa protect
Trả lời
18
Đọc
268
HeSanbi
HeSanbi
NguyenNgocThuHien
  • Question Question
Liệt kê tổ hợp chập k của nhóm n phần tử. (3 người xem)
    • Thích
    • Yêu thích
2 3
Trả lời
54
Đọc
17K
phương Đức
P
T
  • Question Question
Tìm này không xuất hiện trong khoảng thời gian
Trả lời
7
Đọc
109
tuan16
T
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
5
Đọc
193
befaint
befaint
nghiahandsome1995
Xin mã code autofit
Trả lời
4
Đọc
150
yaaasoo01
Y
tuankieu28
Hỗ trợ sửa hàm tìm thông tin
Trả lời
1
Đọc
48
thuytrangbp28
T
N
Cho em xin hỏi về hàm Workday về ngày làm bù ạ
Trả lời
3
Đọc
94
hoangtuaotrang_hp_vn
H
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom