Nhờ anh chị viết code vba thay thế cho hàm Sumifs

Liên hệ QC

kimthoa89

Thành viên thường trực
Tham gia
3/11/17
Bài viết
215
Được thích
17
Giới tính
Nữ
Dear anh !
Em vừa làm lại bảng chốt chấm công
Hiện nay em chấm công cho toàn thể công ty là hơn 3000 người , mà dùng công thức sumifs : Vì vậy rất mong anh giúp đỡ file VBA
1. Sheet "Chấm công " tại ô E13 ->E16 lấy dữ liệu bên sheet "Data" tại cột R->U
Tương ứng : E13 : Cột R
E14 : Cột S
E15 : Cột T
E16 : Cột U
Lấy dữ liệu theo ngày và theo ID. Khi bấm nút nhập thì toàn bộ được cập nhật theo dữ liệu Sheet " Data"
Cảm ơn anh giúp đỡ ạ !
 

File đính kèm

  • Chấm công 1.rar
    150.6 KB · Đọc: 26
Dear anh !
Em vừa làm lại bảng chốt chấm công
Hiện nay em chấm công cho toàn thể công ty là hơn 3000 người , mà dùng công thức sumifs : Vì vậy rất mong anh giúp đỡ file VBA
1. Sheet "Chấm công " tại ô E13 ->E16 lấy dữ liệu bên sheet "Data" tại cột R->U
Tương ứng : E13 : Cột R
E14 : Cột S
E15 : Cột T
E16 : Cột U
Lấy dữ liệu theo ngày và theo ID. Khi bấm nút nhập thì toàn bộ được cập nhật theo dữ liệu Sheet " Data"
Cảm ơn anh giúp đỡ ạ !
sao phải sử dụng vba mà không dùng hàm, dùng hàm được mà
 
Upvote 0
Nếu bạn đừng mở đầu bằng tiếng Tây thì tôi đã thử giúp. Cái đầu tôi nó chướng lắm, hễ thấy tiếng Tây là nó dừng làm việc.

Nhưng mà không sao, bài này là căn bản lựa, xếp, và tổng. Diễn đàn này có ít nhất vài chục người cốt dễ dàng. Cứ đợi đến chiều sẽ có cốt.
 
Upvote 0
Nếu bạn đừng mở đầu bằng tiếng Tây thì tôi đã thử giúp. Cái đầu tôi nó chướng lắm, hễ thấy tiếng Tây là nó dừng làm việc.

Nhưng mà không sao, bài này là căn bản lựa, xếp, và tổng. Diễn đàn này có ít nhất vài chục người cốt dễ dàng. Cứ đợi đến chiều sẽ có cốt.
Bài này dùng dit được không Bác? Tối em về thử xem.
 
Upvote 0
Đã code thử nhưng chay khá chậm file khi full data phải mất tầm 30p mới chạy xong. Mọi người có cách nào để vba có thể chạy 2 vòng lặp for song song. hay kiểu vòng lặp có 10 cái chân để bước 10 bước cùng lúc.
 
Upvote 0
Đã code thử nhưng chay khá chậm file khi full data phải mất tầm 30p mới chạy xong. Mọi người có cách nào để vba có thể chạy 2 vòng lặp for song song. hay kiểu vòng lặp có 10 cái chân để bước 10 bước cùng lúc.
Công ty 3000 người, dùng Excel để chấm công thì 30 phút là phước rồi. Với mức hà tiện thế này thì thời gian không quan trọng, độ chính xác của kết quả quan trọng hơn.
Hồi tôi còn làm với kiểm toán, cỡ chấm công vài trăm trở lên là nhân viên phải qua huấn luyện. Một ngàn trở lên là quy trình phải đem trình qua công đoàn.
Cỡ vài ngàn công nhân mà làm qua Excel, lại lụm code VBA ở đâu về là khả năng tụi kiểm toán "qualify" rất cao.

(*) đối với công ty trên sàng chứng khoán, bị kiểm toán "qualified" là sàng có khả năng ngưng đăng (không giao dịch mua bán cổ phiếu gì hết), nhà băng (chủ nợ lớn) bắt đầu rục rịch.
 
Upvote 0
Dear anh !
Em vừa làm lại bảng chốt chấm công
Hiện nay em chấm công cho toàn thể công ty là hơn 3000 người , mà dùng công thức sumifs : Vì vậy rất mong anh giúp đỡ file VBA
1. Sheet "Chấm công " tại ô E13 ->E16 lấy dữ liệu bên sheet "Data" tại cột R->U
Tương ứng : E13 : Cột R
E14 : Cột S
E15 : Cột T
E16 : Cột U
Lấy dữ liệu theo ngày và theo ID. Khi bấm nút nhập thì toàn bộ được cập nhật theo dữ liệu Sheet " Data"
Cảm ơn anh giúp đỡ ạ !
Code khá kén chọn dữ liệu, chỉ dùng khi sheet Data chỉ lưu dữ liệu 1 tháng và xếp thứ tự theo nhân viên
Mã:
Sub ChamCong()
  Dim sArr(), Res(), iCode
  Dim sRow&, sCol&, i&, j&, k&, iR&, jC&, n&
 
  With Sheets("Data")
    sArr = .Range("A1:U" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    aShift = .Range("R1:U1").Value
  End With
 
  ReDim Res(1 To 100000, 1 To 35)
  sRow = UBound(sArr)
  For i = 2 To sRow
    iCode = sArr(i, 2)
    If iCode <> sArr(i - 1, 2) Then
      n = n + 1
      Res(k + 1, 1) = n
      For j = 1 To 4
        k = k + 1
        Res(k, 2) = iCode
        Res(k, 3) = sArr(i, 3)
        Res(k, 4) = aShift(1, j)
      Next j
    End If
    jC = Day(sArr(i, 1)) + 4
    For j = 18 To 21
      If sArr(i, j) > 0 Then
        Res(k - 21 + j, jC) = sArr(i, j)
      End If
    Next j
  Next i
 
  With Sheet2
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 12 Then .Range("A13:AI" & i).ClearContents
    If k Then .Range("A13").Resize(k, 35) = Res
  End With
End Sub
 
Upvote 0
Anh có
Code khá kén chọn dữ liệu, chỉ dùng khi sheet Data chỉ lưu dữ liệu 1 tháng và xếp thứ tự theo nhân viên
Mã:
Sub ChamCong()
  Dim sArr(), Res(), iCode
  Dim sRow&, sCol&, i&, j&, k&, iR&, jC&, n&
 
  With Sheets("Data")
    sArr = .Range("A1:U" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    aShift = .Range("R1:U1").Value
  End With
 
  ReDim Res(1 To 100000, 1 To 35)
  sRow = UBound(sArr)
  For i = 2 To sRow
    iCode = sArr(i, 2)
    If iCode <> sArr(i - 1, 2) Then
      n = n + 1
      Res(k + 1, 1) = n
      For j = 1 To 4
        k = k + 1
        Res(k, 2) = iCode
        Res(k, 3) = sArr(i, 3)
        Res(k, 4) = aShift(1, j)
      Next j
    End If
    jC = Day(sArr(i, 1)) + 4
    For j = 18 To 21
      If sArr(i, j) > 0 Then
        Res(k - 21 + j, jC) = sArr(i, j)
      End If
    Next j
  Next i
 
  With Sheet2
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 12 Then .Range("A13:AI" & i).ClearContents
    If k Then .Range("A13").Resize(k, 35) = Res
  End With
End Sub
Anh có thể gửi cho em file được không ạ, em cảm ơn anh
 
Upvote 0
Thử code này. Lưu ý tên sheet chấm công phải sửa là cham_cong mới chạy code được nha
Mã:
Sub Cham_Cong()
Dim sArr(), i As Long, Dic As Object, ID As String, Res()
Dim k As Long, n As Long, Ngay As Long, x As Long
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Data")
   sArr = .Range("A2", .[A65536].End(3)).Resize(, 21).Value
End With
ReDim Res(1 To UBound(sArr), 1 To 35)
For i = 1 To UBound(sArr)
   ID = sArr(i, 2)
   Ngay = Day(sArr(i, 1))
   If Not Dic.exists(ID) Then
      k = k + 4
      n = n + 1
      Dic.Add ID, k
      Res(k - 3, 1) = n
      Res(k - 3, 2) = ID
      Res(k - 3, 3) = sArr(i, 3)
      Res(k - 2, 2) = ID
      Res(k - 2, 3) = sArr(i, 3)
      Res(k - 1, 2) = ID
      Res(k - 1, 3) = sArr(i, 3)
      Res(k, 2) = ID
      Res(k, 3) = sArr(i, 3)
      Res(k - 3, 4) = "WH-D"
      Res(k - 2, 4) = "WH-N"
      Res(k - 1, 4) = "OVT-D"
      Res(k, 4) = "OVT-N"
      Res(k - 3, Ngay + 4) = sArr(i, 18)
      Res(k - 2, Ngay + 4) = sArr(i, 19)
      Res(k - 1, Ngay + 4) = sArr(i, 20)
      Res(k, Ngay + 4) = sArr(i, 21)
   Else
      x = Dic.Item(ID)
      Res(x - 3, Ngay + 4) = sArr(i, 18)
      Res(x - 2, Ngay + 4) = sArr(i, 19)
      Res(x - 1, Ngay + 4) = sArr(i, 20)
      Res(x, Ngay + 4) = sArr(i, 21)
   End If
Next
With Sheets("Cham_Cong")
   .Range("A13").Resize(k, UBound(Res, 2)) = Res
End With
End Sub
 
Upvote 0
Anh gửi cho em file tham khảo với được không ạ, em cảm ơn anh!
 
Upvote 0
Anh cho em hỏi, tại sao khi e copy từ máy chấm công của tháng mới vào thì nó lại nhảy từ ngày mùng 4 ạ. Anh xem giúp em với ạ, em cảm ơn anh
 

File đính kèm

  • Chấm công 1 (1).xlsb
    33.1 KB · Đọc: 4
Upvote 0
Sao em chuyển định dạng , nhưng lại báo lỗi số 13 ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Nhờ anh xem giúp ạ !
Một số ID thì ra đúng , 1 số ID khi copy từ dữ liệu bảng công vào thì ra lại không đúng ạ

1586779014314.png

1586779074729.png
 

File đính kèm

  • Chấm công -123.rar
    3.3 MB · Đọc: 8
Upvote 0
Nhờ anh xem giúp ạ !
Một số ID thì ra đúng , 1 số ID khi copy từ dữ liệu bảng công vào thì ra lại không đúng ạ

View attachment 235505

View attachment 235506
Code đúng là đúng, sai là sai. Không bao giờ lúc đúng lúc sai. Bạn kiểm tra lại dữ liệu nguồn sẽ tìm được nguyên nhân. Hoặc chờ người khác xem hộ nhé, mình bận rồi nên không giúp tiếp được nữa
 
Upvote 0
Web KT
Back
Top Bottom