Nhờ hoàn thiện Bảng tính lương

[phuongc5]

Chào các thành viên!
Từ trước đến giờ mình chỉ làm chân ngoại giao của phòng Kế toán. Bây giờ Sếp lại giao cho mình làm sổ lương nữa (chán quá, vất vả mà). Mình vừa thiết kế sơ bộ được 1 bảng lương, mong mọi người góp ý cho mình với. Thứ nhất nó nhiều công thức nên tính toán chậm, thứ 2 trình bày chưa khoa học (không có kinh nghiệm mà). Rất mong được giúp đỡ, chỉ dạy.

 

[SA_DQ]

Cũng chỉ mới có khoảng 150 người mà đã ì ạch, chắc 300 người thì nằm iêm luôn quá!

Bạn dùng quá nhiều SUMPRODUCT() & VLOOKUP(), . . .

Mình viết cho bạn 1 macro này để bỏ các công thức tại cột 'C' của bảng 'TH"

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Columns(2)) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range
      
   Set Sh = Sheets("ThamChieu")
   Set Rng = Sh.Range(Sh.[b1], Sh.[b65500].End(xlUp))
   Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
   If sRng Is Nothing Then
      Target.Offset(, 1).Value = "Chua Co Nguoi Nay"
   Else
      Target.Offset(, 1).Value = sRng.Offset(, 1).Value
   End If
 End If
End Sub

Macro có nhiệm vụ điền họ tên vô cột 'C' cho bạn hễ bạn nhập mã nhân viên vô cột kể trài với nó.

(*) Mà bạn đặt tên các trang tính gì mà lê thê làm vậy? Sao không là T01, T02, . .. T10,T11, T12 là phân biệt được rồi;

(*) Bạn cần gì phải tô màu cả dòng làm gì tốn màu làm vậy;
Mình đề nghị bạn sửa câu lệnh tô màu như sau:

Thay vì:

Rows(Target.Row).Interior.ColorIndex = 6

Chỉ nên là:

Cells(Target.Row, "A").Resize(, 26).Interior.ColorIndex = 6

Phải biết tiết kiệm tài nguyên bàn à!

(*) Còn tiếp, nếu bạn đồng í theo hướng này. . .

Thân ái!

 

[phuongc5]

Cảm ơn anh đã giúp. Như anh nói là dùng quá nhiều hàm Sumprpduct nên chạy chậm, anh có phương pháp nào thay thế mong anh giúp em với!!

 

[SA_DQ]

Dùng quá nhiều hàm Sumprpduct chạy chậm, anh có phương pháp nào thay thế mong anh giúp em với!!

Viếc dùng macro thay thế hàm đó thì trong khả năng thôi;
Nhưng chưa rõ vấn đề như sau:
Tại sao trong trang 'ThamChieu' có 2 trường mã & 2 trường HoTen;
Có lúc trên cùng 1 dòng 2 mã này trùng nhau, nhưng cũng có khi không trùng nhau;
Và quan trọng là khi nào tham chiếu đến mã đến cột 'B' & khi nào tham chiếu đến mã ở cột 'D' vậy?

 

[phuongc5]

Như thế này anh ạ, cột B chỉ là dữ liệu gốc để tham khảo (mỗi khi có phát sinh thì em copy vào cột D). Còn tại cột D, ngoài việc phát sinh tiền lương cơ bản của cả cơ quan hàng tháng (nhân viên nào cũng có tên) thì cơ quan em còn có rất nhiều đề tài, dự án và chỉ những phòng nào tham gia thì mới có phát sinh, dẫn đến trong 1 tháng có thể 1 người có phát sinh đến 3, 4 lần. Nên ý tưởng của em là cứ phát sinh ai thì nhập mã vào cột D và nhập tháng phát sinh. Sau đó, sang Sheet'tonghop' sẽ cộng tất cả những gì phát sinh trong 1 tháng tương ứng với 1 nhân viên. Tóm lại là ở Sheet'tonghop' chỉ tham chiếu đến cột D của Sheet'thamchieu' mà thôi.
Rất mong được anh giúp đỡ.

 

[SA_DQ]

Xem thêm trong file đính kèm (Tại trang tính 'TH'

(Bạn có thể bỏ hầu hết các công thức VLOOKUP() được rồi đó!)

Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Loi_WC:
 If Not Intersect(Target, Columns(2)) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range
   Dim Rng0 As Range, sRng0 As Range:                 Dim MyAdd As String
   Dim jJ As Byte, Zz As Byte
     
   Set Sh = Sheets("ThamChieu")
   Set Rng = Sh.Range(Sh.[B1], Sh.[b65500].End(xlUp))
   Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
   If sRng Is Nothing Then
      Target.Offset(, 1).Value = "Chua Co Nguoi Nay"
   Else
      Target.Offset(, 1).Value = sRng.Offset(, 1).Value
                
      Set Rng0 = Sh.Range(Sh.[D1], Sh.[b65500].End(xlUp))
      Set sRng0 = Rng0.Find(Target.Value)
      If Not sRng0 Is Nothing Then
         Do
            With Target.Offset(, 7 * sRng0.Offset(, 2).Value - 25)
               For jJ = 0 To 3
                  .Offset(, jJ).Value = .Offset(, jJ).Value + sRng0.Offset(, 3 + jJ).Value
               Next jJ
            End With
            Set sRng0 = Rng0.FindNext(sRng0)
         Loop While Not sRng0 Is Nothing And sRng0.Address <> MyAdd
      End If
   End If
 End If
Err_WC:                 Exit Sub
Loi_WC:
   Select Case Err
   Case 1004
      MsgBox "Khong Co!"
   Case Else
      MsgBox Error, , Err
   End Select
   Resume Err_WC
End Sub

 

[phuongc5]

Em rất cảm ơn anh vì sự nhiệt tình giúp đỡ của anh. Nhưng anh à, có thể em diễn đạt tối nghĩa nên anh chưa hiểu ý của em. Ý em là, cột B và C ở Sheet'thamchieu' là cái cố định, để em có thể nhìn vào đấy em copy sang cột D mỗi khi có phát sinh. cột B và C ở bên sheet'TH' cũng cố định luôn. Cột D của sheet'thamchieu' cứ mỗi khi trả lương, thưởng, khác... thì nhập vào tương ứng với các cột: tháng, lương, phụ cấp, khác... Em muốn là cột E ở sheet'TH' (Lương) sẽ cộng tất cả những khoản lương phát sinh trong 1 tháng của 1 mã nhân viên (=sumproduct(TH!B3:B142=thamchieu!D265000)*(thamchieu!F2:F65000=TH!$A$1)*(thamchieu!G2:G65000).
Tương tự như thế với các cột F, G, H của sheet'TH' ( tương ứng với phụ cấp, khác, giảm)

 

[SA_DQ]

Em muốn là cột E ở sheet'TH' (Lương) sẽ cộng tất cả những khoản lương phát sinh trong 1 tháng của 1 mã nhân viên (=sumproduct(TH!B3:B142=thamchieu!D265000)*(tham chieu!F2:F65000=TH!$A$1)*(thamchieu!G2:G65000).
Tương tự như thế với các cột F, G, H của sheet'TH' ( tương ứng với phụ cấp, khác, giảm)

Hình như bạn viết chưa chính xác, mà là cột 'E' là tổng hợp các khoản phát sinh lương của tháng 4 (tương ứng F - Phụ cấp; G - khác; & H - giảm) của từng người;

Tương tự như vậy, cột 'L' là lương của tháng 5; . . . .

Macro đã làm được cái việc tổng hợp cho từng người; Có nghĩa là bạn nhập mã nhân viên, nó sẽ tìm tên nhân viên gán vô & tìm tất thẩy các khoản lương tháng 4 nhét vô cột 'E' của người đó (Dòng đó); Tương tự như vậy với tất cả các cột khác sau 'E' của người đó. nếu bên 'ThamChieu' có dữ liệu.

Nếu bạn muốn lập 1 macro tính toàn bô cho trang tính 'TH' thì OK thôi, nhưng chờ sau vài giờ nữa

Xin hỏi thêm, các tháng sau tháng 6 & trước tháng 4 sẽ như thế nào? Sao bạn không làm trang 'TH' thành trang tổng hợp cả năm luôn; Nếu bạn muốn mỗi quý 1 trang tính thì mình xin rút í kiến, thế nha! (Nhưng vẫn khuyên bạn nhốt chung chúng vô 1 trang tính mà thôi!)

? ngoài lề: Các tên cơ quan của bạn trước đây là gì vậy, nếu không có gì phiền phức!

 

[phuongc5]

Macro đã làm được cái việc tổng hợp cho từng người; Có nghĩa là bạn nhập mã nhân viên, nó sẽ tìm tên nhân viên gán vô & tìm tất thẩy các khoản lương tháng 4 nhét vô cột 'E' của người đó (Dòng đó); Tương tự như vậy với tất cả các cột khác sau 'E' của người đó. nếu bên 'ThamChieu' có dữ liệu.
Ý em muốn là không phải mỗi khi mình nhập mã nhân viên thì nó mới tìm bên Sheet'thamchieu' để nhét vô, mà em muốn là cột mã nhân viên mình luôn cố định rồi, tại cột E của Sheet'TH' nó nhìn vào mã nhân viên có sẵn đó để quay sang Sheet'thamchieu', đối chiếu ở cột D, thấy dòng tương ứng với mã nhân viên đấy phát sinh thì nhập vào


Xin hỏi thêm, các tháng sau tháng 6 & trước tháng 4 sẽ như thế nào? Sao bạn không làm trang 'TH' thành trang tổng hợp cả năm luôn; Nếu bạn muốn mỗi quý 1 trang tính thì mình xin rút í kiến, thế nha! (Nhưng vẫn khuyên bạn nhốt chung chúng vô 1 trang tính mà thôi!)

File em up lên đấy, ý tưởng của em là vì mình nộp báo cáo theo quý nên tại ô A1 của Sheet'TH' cứ đến cuối quý thì mình sẽ nhập số là số của tháng đầu quý (VD làm BC quý 1 thì ô A1=1, Quý 2 thì ô A1=4, quý 3 thì ô A1=7, quý 4 thì ô A1=10). Số liệu bên sheet'thamchieu' mình có thể nhập cho cả năm, nhưng tại ô A1 của Sheet'TH' tuỳ theo mình nhập số nào thì nó chỉ thể hiện 3 tháng liên tiếp mà thôi (Tháng A1, Tháng A1+1, tháng A1+2).
Vì ý tưởng ban đầu em làm bằng công thức nên như thế, bây giờ có sự trợ giúp của Macro thì anh giúp em làm theo cả năm nhé.
(Em cảm thấy mình thật được ưu ái khi anh tận tình giúp đỡ. Cảm ơn anh nhiều)
(P/S: Tên cơ quan của em ngày xưa là: Viện Nghiên cứu mỏ và Luyện kim. Khi chuyển đổi theo NĐ115 thì đổi tên thành Viện Khoa học và Công nghệ Mỏ - Luyện kim)

 

[SA_DQ]

Đúng cho 4 quý rồi đây

Option Explicit
Sub LuongQuy()
 On Error GoTo Loi_LQ
 Dim Sh As Worksheet:                        Dim MyAdd As String
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim Thang, jJ As Byte, Col As Byte
 
 Set Sh = Sheets("ThamChieu"):               Sheets("TH").Select
 Set Rng = Sh.Range(Sh.[D1], Sh.[d65500].End(xlUp))
 For Each Clls In Range([b3], [b65500].End(xlUp))
   Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         Thang = [a1].Value:                 If Thang Mod 3 <> 1 Then Exit Sub
         Col = Switch(Thang = 1, 4, Thang = 4, 25, Thang = 7, 46, Thang = 10, 67)
         With Clls.Offset(, 7 * sRng.Offset(, 2).Value - Col)
            For jJ = 0 To 3
               .Offset(, jJ).Value = .Offset(, jJ).Value + sRng.Offset(, 3 + jJ).Value
            Next jJ
         End With
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   Else
      With Clls
         MsgBox .Value & Chr(10) & .Offset(, 1), , "Khong Co Nguoi nay"
         .Offset(, 1).Font.ColorIndex = 32
      End With
   End If
 Next Clls
Err_LQ:                                      Exit Sub
Loi_LQ:
   MsgBox Error(), , Clls.Address:           Resume Err_LQ
End Sub

Muốn làm cho cả năm thì chờ thêm 1 vài ngày nữa nha!

 

[SA_DQ]

Xong cho bạn rồi đây, té ra dễ hơn chúng ta tưởng

Option Explicit
Sub LuongQuy()
 On Error GoTo Loi_LQ
 Dim Sh As Worksheet:                        Dim MyAdd As String
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim Thg, jJ As Byte:                        Const Col As Byte = 4
 
 Set Sh = Sheets("ThamChieu"):               Sheets("TH").Select
 [e3].Resize([a65500].End(xlUp).Row + 123, 123).ClearContents
 Set Rng = Sh.Range(Sh.[D1], Sh.[d65500].End(xlUp))
 
 For Each Clls In Range([b3], [b65500].End(xlUp))
   Set sRng = Rng.Find(Clls.Value, , xlValues, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         With Clls.Offset(, 7 * sRng.Offset(, 2).Value - Col)
            For jJ = 0 To 3
               .Offset(, jJ).Value = .Offset(, jJ).Value + sRng.Offset(, 3 + jJ).Value
            Next jJ
         End With
         
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   Else
      With Clls
         MsgBox .Value & Chr(10) & .Offset(, 1), , "Khong Co Nguoi nay"
         .Offset(, 1).Font.ColorIndex = 32
      End With
   End If
 Next Clls
Err_LQ:                                      Exit Sub
Loi_LQ:
   MsgBox Error(), , Clls.Address:           Resume Err_LQ
End Sub

 

[phuongc5]

Anh ơi, anh thử giải thích tuần tự cách nhập dữ liệu như thế nào giúp em với vì em nhập thử một vài trường hợp bên Sheet'thamchieu' nhưng chuyển sang sheet'TH' không thấy có sự thay đổi gì cả
(P/S: Đúng là cơ quan em ngày trước tiền thân là P70 đóng trên địa bàn Thái Nguyên, nhưng bây giờ thế hệ ấy về hưu gần hết rồi. Nhưng danh sách địa chỉ để liên lạc thì em có đấy)

 

[SA_DQ]

Anh ơi, anh thử giải thích tuần tự cách nhập dữ liệu như thế nào giúp em với vì em nhập thử một vài trường hợp bên Sheet'thamchieu' nhưng chuyển sang sheet'TH' không thấy có sự thay đổi gì cả

Macro làm mỗi việc là điền các dữ liệu đã nhập trên trang 'ThamChieu' sang vùng 2 của góc tọa độ được coi là 'E2'

[e3].Resize([a65500].End(xlUp).Row + 123, 123).ClearContents 
'Xóa dữ liệu của vùng B tọa độ'

Vùng này nè & nó được xóa dữ liệu trước mỗi khi macro bắt đầu làm việc;

Để macro chạy, mình đã gán phím tắt, đó là {CTRL}+{SHIFT}+L (Bạn có thể đổi lại theo í của mình)
Lúc đó macro sẽ lần lượt duyệt từng record của 'TH' tham chiếu đến cột 'D' của 'ThamChieu' & sẽ lấy số liệu tương ứng cộng vô các cột tương ứng với trị số tháng trong cột 'F'
(Hiện tại mới có tiêu đền của 8 tháng, nhưng nếu bân nhập tháng 12 vô cột 'F' này thì macro cũng sẽ làm, nhưng sẽ chưa có tiêu đề các tháng >8 - Việc bổ sung giành cho bạn)

Hiện tại bạn có thể đổi số liệu của 'VU TAN CO' để kiểm tra cách mà macro làm việc.

((huyện riêng: P70 được tách ra từ cơ quan cũ của mình đó nha!)

 

[phuongc5]

Cảm ơn anh nhiều lắm, em đã thử, rất pro. Tuy nhiên em không phải dân kỹ thuật nên nhìn vào code như nhìn vào vách, chỉ biết áp dụng, không hỏi tại sao. Khi nào có trục trặc em sẽ làm phiền bác nhé!
À, cho em hỏi thêm một chút là, bây giờ em muốn chèn dòng ở sheet'TH' thì có ảnh hưởng gì không (vì em không hiểu đựoc code mà)
Anh ơi, lại phát sinh vấn đề nữa rồi, macro lại xoá hết công thức cột "TNTT" (thu nhập tính thuế), cột "thuế" và cột "còn lĩnh" của em. Anh có thể chỉnh code để nó xoá từ cột E đến cột H, sau đó lại cách 3 cột mới xoá tiếp (vì cột I, J, K em còn đặt công thức mà), cứ như thế đến tháng 12 thì thôi (à, đến tháng 13 đi vì em còn các cột tổng cộng cho cả năm nữa thì coi như 1 tháng)

 

[SA_DQ]

(1)

Anh ơi, lại phát sinh vấn đề nữa rồi, macro lại xoá hết công thức cột "TNTT" (thu nhập tính thuế), cột "thuế" và cột "còn lĩnh" của em.

Bạn Copy toàn bộ macro này và chép đè lên toàn bộ macro cũ (Kể cả dòng Option Explicit đó nha)
Mình đã đánh đấu vùng thay đổi, để có dịp bạn ngâm cứu

Option Explicit
Sub LuongCaNam()
 On Error GoTo Loi_LQ
 Dim Sh As Worksheet:                        Dim MyAdd As String
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim Thg, jJ As Byte:                        Const Col As Byte = 4
 
 Set Sh = Sheets("ThamChieu"):               Sheets("TH").Select
 
 For Thg = 0 To 12              '<=|'
   Cells(3, 4 + Thg * 7).Resize([B65500].End(xlUp).Row + 99, 4).ClearContents
 Next Thg                '<=|'
 Set Rng = Sh.Range(Sh.[D1], Sh.[D65500].End(xlUp))
 For Each Clls In Range([b3], [B65500].End(xlUp))
   Set sRng = Rng.Find(Clls.Value, , xlValues, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         With Clls.Offset(, 7 * sRng.Offset(, 2).Value - Col)
            For jJ = 0 To 3
               .Offset(, jJ).Value = .Offset(, jJ).Value + sRng.Offset(, 3 + jJ).Value
            Next jJ
         End With
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   Else
      With Clls
         MsgBox .Value & Chr(10) & .Offset(, 1), , "Khong Co Nguoi nay"
         .Offset(, 1).Font.ColorIndex = 32
      End With
   End If
 Next Clls
Err_LQ:                                      Exit Sub
Loi_LQ:
   MsgBox Error(), , Clls.Address:           Resume Err_LQ
End Sub

(2)

À, cho em hỏi thêm một chút là, bây giờ em muốn chèn dòng ở sheet'TH' thì có ảnh hưởng gì không

Không sao , miễn trên cột 'B; có mã nhân viên mới nhập là được;

(3) Chú ý: Do chúng ta đã đổi tên macro; nên tổ hợp phím tắc phải cài mới đó nha!

Bạn an tâm về chương trình; Mình sẽ bảo hành miễn phí trong thời gian mình còn trên GPE của chúng ta;

 

[phuongc5]

Cells(3, 4 + Thg * 7).Resize([B65500].End(xlUp).Row + 99, 4).ClearContents

1) Anh ơi, cho em hỏi đoạn code này nó xoá từ dòng nào đến dòng nào vậy
2) Em đã test và kết quả như sau:Nó xoá hết cột "còn lĩnh" từ tháng 1 đến tháng 12 (riêng tháng 13 thì không), cột "giảm" mỗi khi chạy macro nó không xoá đi mà cộng dồn vào (ví dụ lúc đầu là 10, thực hiện macro thì thành 20, thực hiện lần nữa thì thành 30)
3) Anh sửa cho em chỉ xoá đến tháng 12 thôi, vì cột tháng 13 (cả năm) là công thức cộng cho cả năm, nó xoá thì lại hỏng.

 

[phuongc5]

Bác SA_DQ ơi, chắc bác bận lắm nên không "bảo hành miễn phí" giúp em với

 

[SA_DQ]

Cells(3, 4 + Thg * 7).Resize([B65500].End(xlUp).Row + 99, 4).ClearContents
1) Anh ơi, cho em hỏi đoạn code này nó xoá từ dòng nào đến dòng nào vậy
2) Em đã test và kết quả như sau:Nó xoá hết cột "còn lĩnh" từ tháng 1 đến tháng 12 (riêng tháng 13 thì không), cột "giảm" mỗi khi chạy macro nó không xoá đi mà cộng dồn vào (ví dụ lúc đầu là 10, thực hiện macro thì thành 20, thực hiện lần nữa thì thành 30)

Số dòng có lẽ chưa quan trọng bằng cột!
Nói về cột: nó sẽ xóa 4 cột căn cứ vô sự biến thiên của Thg (Thg biến thiên từ 0 đến 11)
sẽ tìm ra cột đầu (trong vòng lặp 12 tháng) theo bảng sau:

Thg|Cột bắt đầu| Cột
0| 4 + 0 * 7|D->G
1| 4 + 7| 11->14
||
3| 4 + 7*3|25->28
||
11|4 + 77|81->84

Bạn có thể dùng hàm =Columns() trong excel để kiểm tra lại;
Nếu các tháng đầu đã đúng thì các tháng sau bạn copy đã sai;
Còn nếu không phải xóa 4 cột liền nhau thì phải viết lại các dòng lệnh này

(Xin lỗi vì để bạn chờ lâu!)

3) Anh sửa cho em chỉ xoá đến tháng 12 thôi, vì cột tháng 13 (cả năm) là công thức cộng cho cả năm, nó xoá thì lại hỏng.

Nếu chỉ xóa 12 tháng thì sửa con số 12 thành con số 11 để Thg biến thiên trong khoảng 0-> 11 thôi

 

[phuongc5]

Em dang o nha nen ko co may tinh de thu, em online qua dien thoai nen viet chu cung ko co dau nua. Nhung neu the thi em tuong code viet phai la: cell(4 + thg*7) theo cach giai thich o bai cuoi, nhung anh lai viet la: cell(3,4 + thg*7) lieu co thua so 3 ko anh. Em ko hieu ve code nen ko biet em hoi the co dung ko nua, mong anh thong cam.
Cam on anh nhieu!

 

[SA_DQ]

Em đang ở nhà nên không có máy tính để thử, em online qua điện thoại nên viết chữ cũng không có dấu nữa. Nhưng nếu thế thì em tưởng code phải viết là: cell(4 + thg*7) theo cách giải thích ở bài cuối, nhưng anh lại viết là: cells(3,4 + Thg*7) liệu có thừa số 3 không anh? Em không hiểu về code nên không biết em hỏi thế có đúng không nữa, mong anh thông cảm.
Cảm ơn anh nhiều!

Bạn cứ coi như 1 ô là 1 điểm nằm trên mặt phẵng tọa độ;
Một điểm phải có tung độ & hoành độ;
Cái số 3 đó là chỉ số hàng (tung độ đó);
Nhưng với phương thức Offset(x, y) thì có thể ngầm định là thiếu hoặc x hoặc y hoặc thiếu cả 2 cũng xong ( Vói phương thức Resize(x, y) cũng gần vậy) . . .

Hẹn sớm gặp lại!