Tính số nhân công (1 người xem)

Bích Tỷ · 12/4/22

Em xin chào anh/chị,
Em có một file tính toán số lượng nhân công, em làm thủ công thì lâu quá. em nhờ anh chị hỗ trợ giúp em với. em xin cảm ơn.
Yêu cầu: Kết quả trả về từ sheet "CHAT" đến sheet "MAY-THANHHINH"
Do em mô tả hơi dài nên yêu cầu em để trong file ạ

snow25 · 12/4/22

Bích Tỷ đã viết:
Em xin chào anh/chị,
Em có một file tính toán số lượng nhân công, em làm thủ công thì lâu quá. em nhờ anh chị hỗ trợ giúp em với. em xin cảm ơn.
Yêu cầu: Kết quả trả về từ sheet "CHAT" đến sheet "MAY-THANHHINH"
Do em mô tả hơi dài nên yêu cầu em để trong file ạ

Chắc ai nhiệt tình thì code 1 vài code đây bạn muốn code cả file chắc phải đợi dài dài.Đến đọc hết nội dung các yêu cầu của bạn tôi còn không đọc hết.

Bích Tỷ · 12/4/22

snow25 đã viết:
Chắc ai nhiệt tình thì code 1 vài code đây bạn muốn code cả file chắc phải đợi dài dài.Đến đọc hết nội dung các yêu cầu của bạn tôi còn không đọc hết.

dạ chào anh,
Anh có thể hỗ trợ em xử lý từng sheet không ạ. em cảm ơn
- 2 sheet CHAT và DEM tính giống nhau anh ạ. sheet IN thì thay đổi công thức ở cột C và D ạ, e có làm công thức trong file ạ.

SA_DQ · 12/4/22

Bạn thử kiểm tra số liệu ngày 28 xem sao;
(Các bạn có thể xem file ở các bài của mình bên dưới & xin cảm ơn!)
$$$$@

Bích Tỷ · 13/4/22

SA_DQ đã viết:
Bạn thử kiểm tra số liệu ngày 28 xem sao;
(Số liệu đang ở dòng 30 trở đi để bạn đối chiếu)

cảm ơn anh, em sẽ kiểm tra.

SA_DQ · 13/4/22

(1) Macro sự kiện trong file chỉ đang thực hiện 2 cột số liệu liền nhau (sau khi ta chọn 1 ngày cụ thể nào đó)
Còn macro sau sẽ cho ta tính năng tạo báo cáo số liệu của 4 ngày liên tiếp

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Dat As Date, Col As Integer, Rws As Long, J As Long, rMax As Integer
 Dim W1 As Integer, W5 As Integer, W9 As Integer, W13 As Integer
 Dim Sh As Worksheet, Cls As Range, Rng As Range, Arr()
 
 On Error Resume Next
 If Not Intersect(Target, [A2]) Is Nothing Then
    Set Sh = ThisWorkbook.Worksheets("KeHoach")
    Rws = Sh.[C2].CurrentRegion.Rows.Count
    [A30:AN99].ClearContents
'Tìm Ngày Bát Dàu:      '
    For Each Cls In Sh.Range(Sh.[h1], Sh.[h1].End(xlToRight))
        If Cls.Value = Target.Value Then
            Col = Cls.Column:                Arr() = Sh.[A2].Resize(Rws, 3 + Col).Value
            Exit For
        End If
    Next Cls
    ReDim aKQ1(1 To 99, 1 To 2):            ReDim aKQ5(1 To 99, 1 To 2)
    ReDim aKQ9(1 To 99, 1 To 2):            ReDim aKQ13(1 To 99, 1 To 2)
    Rows("5:99").Hidden = False:            [A5].Resize(95, 16).ClearContents
   For J = 1 To UBound(Arr())
1        If Arr(J, Col) <> Space(0) Then
            W1 = W1 + 1:                    aKQ1(W1, 1) = Arr(J, 3)
            aKQ1(W1, 2) = Arr(J, Col)
            If W1 > rMax Then rMax = W1
        End If
2        If (Arr(J, 1 + Col)) <> Space(0) Then
            W5 = W5 + 1:                    aKQ5(W5, 1) = Arr(J, 3)
            aKQ5(W5, 2) = Arr(J, 1 + Col)
            If W5 > rMax Then rMax = W5
        End If
3        If (Arr(J, 2 + Col)) <> Space(0) Then
            W9 = W9 + 1:                    aKQ9(W9, 1) = Arr(J, 3)
            aKQ9(W9, 2) = Arr(J, 2 + Col)
            If W9 > rMax Then rMax = W9
        End If
4        If Arr(J, 3 + Col) <> Space(0) Then
            W13 = W13 + 1:                    aKQ13(W13, 1) = Arr(J, 3)
            aKQ13(W9, 2) = Arr(J, 3 + Col)
            If W13 > rMax Then rMax = W13
        End If
    Next J
  
    [A5].Resize(W1, 2).Value = aKQ1():     [e5].Resize(W5, 2).Value = aKQ5()
    [I5].Resize(W9, 2).Value = aKQ9():      [M5].Resize(W13, 2).Value = aKQ13()
    Rows(rMax + 1 & ":99").Hidden = True
  
    MsgBox "Xong Rôi!", , "Xin Chào " & rMax
 End If
End Sub

Bạn thử chép đè toàn bộ macro cũ & cho chạy thử & kiểm tra tiếp

(2)

Bích Tỷ đã viết:
dạ chào anh,
Anh có thể hỗ trợ em xử lý từng sheet không ạ. em cảm ơn
- 2 sheet CHAT và DEM tính giống nhau anh ạ. sheet IN thì thay đổi công thức ở cột C và D ạ, e có làm công thức trong file ạ.

Trang 'Chat' & 'Dem' có vẻ như giống nhau & có thể tạo ra chúng từ 1 cách thức
Nhưng cũng có thể từ trang 'Chat' ta tạo ra 'Dem' (chứ không cần từ trang dữ liệu gốc.).

(3) Mỗi ngày bạn cần 4 cột dữ liệu, vậy 2 cột cuối (của mỗi ngày) bạn đã lấy từ đâu?

Bích Tỷ · 13/4/22

SA_DQ đã viết:
(3) Mỗi ngày bạn cần 4 cột dữ liệu, vậy 2 cột cuối (của mỗi ngày) bạn đã lấy từ đâu?

=> Cột số lượng thì tính tổng theo TEN GIAY (bỏ trùng lập) á anh
2 cột cuối sẽ tính như thế này anh:
cột 8h: Số lượng/6(ô B2)/ô D2/8/ trung bình tiêu chuẩn(*)
cột 9.5h: Số lượng/6(ô B2)/ô D2/9.5/ trung bình tiêu chuẩn(**)
(*) đối với sheet CHAT thì dựa vào TEN GIAY để tìm tiêu chuẩn ở sheet TIEUCHUAN (Cột G)
(**)đối với sheet DEM thì dựa vào TEN GIAY để tìm tiêu chuẩn ở sheet TIEUCHUAN (Cột BA)
- Đối với sheet IN lấy dữ liệu tương tự như 2 sheet trên nhưng cột 8h và 9.5 sẽ tính là:
cột 8h: Số lượng/6(ô B2)/ô D2/(8* trung bình tiêu chuẩn) (***)
cột 9.5h: Số lượng/6(ô B2)/ô D2/(9.5* trung bình tiêu chuẩn) (***)
(***) dựa vào TEN GIAY để tìm tiêu chuẩn ở sheet TIEUCHUAN (Cột Z)
- anh có thể tạo dữ liệu 10 ngày liên tiếp giúp em nha. em cảm ơn anh.

SA_DQ · 13/4/22

Bích Tỷ đã viết:
- anh có thể tạo dữ liệu 10 ngày liên tiếp giúp em nha. em cảm ơn anh.

Lý do sao phải là mươi ngày mà là 5 ngày hay ít hơn
Vì lẽ ta có thể chọn ngày bắt đầu nào đó trong Validation để macro cho ra kết quả chỉ 4 ngày liên tiếp (kể từ ngày được chọn); Nếu cần xem tiếp thì ta bấm chọn tiếp 4 ngày nữa (không được sao?)

Bích Tỷ · 13/4/22

SA_DQ đã viết:
Lý do sao phải là mươi ngày mà là 5 ngày hay ít hơn
Vì lẽ ta có thể chọn ngày bắt đầu nào đó trong Validation để macro cho ra kết quả chỉ 4 ngày liên tiếp (kể từ ngày được chọn); Nếu cần xem tiếp thì ta bấm chọn tiếp 4 ngày nữa (không được sao?)

Dạ, lý do là vì 10 ngày tương ứng 10 tuần (hơn 2 tháng) thì phía bộ phận sản xuất cần sắp xếp số người phù hợp (dự trù) cho cho những tháng kế tiếp á anh.
- Cứ 2 tuần là bảng kế hoạch sẽ cập nhật 1 lần nên sản xuất cần phải làm dự trù 2 tháng để có thể đào tạo nhân công.

SA_DQ · 13/4/22

Macro sự kiện cho mươi ngày của bạn đây, Kiểm tất cả xem sao(?)

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Col As Integer, Rws As Long, J As Long, rMax As Integer
 Dim W1 As Integer, W5 As Integer, W9 As Integer, W7 As Integer, W0 As Integer
 Dim W3 As Integer, W4 As Integer, W6 As Integer, W8 As Integer, W2 As Integer
 Dim Sh As Worksheet, Cls As Range, Rng As Range, Arr()
 Const B2_ As Integer = 6:                      Const D2_ As Double = 1.2
' On Error Resume Next  '
 If Not Intersect(Target, [A2]) Is Nothing Then
    Set Sh = ThisWorkbook.Worksheets("KeHoach")
    Rws = Sh.[C2].CurrentRegion.Rows.Count
    [A30:AN99].ClearContents
'Tìm Ngày Bát Dàu:      '
    For Each Cls In Sh.Range(Sh.[h1], Sh.[h1].End(xlToRight))
        If Cls.Value = Target.Value Then
            Col = Cls.Column:                Arr() = Sh.[A2].Resize(Rws, 9 + Col).Value
            Exit For
        End If
    Next Cls
    ReDim aKQ0(1 To 99, 1 To 3):            ReDim aKQ1(1 To 99, 1 To 2)
    ReDim aKQ2(1 To 99, 1 To 2):            ReDim aKQ3(1 To 99, 1 To 2)
    ReDim aKQ4(1 To 99, 1 To 2):            ReDim aKQ5(1 To 99, 1 To 2)
    ReDim aKQ6(1 To 99, 1 To 2):            ReDim aKQ7(1 To 99, 1 To 2)
    ReDim aKQ9(1 To 99, 1 To 2):            ReDim aKQ8(1 To 99, 1 To 2)
    ReDim aDg(1 To 10, 1 To 1) As Integer
    
    Rows("5:99").Hidden = False:            [A5].Resize(95, 40).ClearContents
    Application.ScreenUpdating = False
   For J = 1 To UBound(Arr())
1        If Arr(J, Col) <> Space(0) Then
            aDg(1, 1) = aDg(1, 1) + 1:      aKQ0(aDg(1, 1), 1) = Arr(J, 3)
            aKQ0(aDg(1, 1), 2) = Arr(J, Col)
            aKQ0(aDg(1, 1), 3) = Arr(J, Col) / B2_ / D2_ / 8
        End If
2        If (Arr(J, 1 + Col)) <> Space(0) Then
            aDg(2, 1) = aDg(2, 1) + 1
            aKQ1(aDg(2, 1), 1) = Arr(J, 3)
            aKQ1(aDg(2, 1), 2) = Arr(J, 1 + Col)
        End If
3        If (Arr(J, 2 + Col)) <> Space(0) Then
            aDg(3, 1) = aDg(3, 1) + 1:                  aKQ2(aDg(3, 1), 1) = Arr(J, 3)
            aKQ2(aDg(3, 1), 2) = Arr(J, 2 + Col)
        End If
4        If Arr(J, 3 + Col) <> Space(0) Then
            aDg(4, 1) = aDg(4, 1) + 1:                  aKQ3(aDg(4, 1), 1) = Arr(J, 3)
            aKQ3(aDg(4, 1), 2) = Arr(J, 3 + Col)
        End If
5        If Arr(J, 4 + Col) <> Space(0) Then
            aDg(5, 1) = aDg(5, 1) + 1:                  aKQ4(aDg(5, 1), 1) = Arr(J, 3)
            aKQ4(aDg(5, 1), 2) = Arr(J, 4 + Col)
        End If
6        If Arr(J, 5 + Col) <> Space(0) Then
            aDg(6, 1) = aDg(6, 1) + 1:                  aKQ5(aDg(6, 1), 1) = Arr(J, 3)
            aKQ5(aDg(6, 1), 2) = Arr(J, 5 + Col)
        End If
7        If Arr(J, 6 + Col) <> Space(0) Then
            aDg(7, 1) = aDg(7, 1) + 1:                  aKQ6(aDg(7, 1), 1) = Arr(J, 3)
            aKQ6(aDg(7, 1), 2) = Arr(J, 6 + Col)
        End If
8        If Arr(J, 7 + Col) <> Space(0) Then
            aDg(8, 1) = aDg(8, 1) + 1:                  aKQ7(aDg(8, 1), 1) = Arr(J, 3)
            aKQ7(aDg(8, 1), 2) = Arr(J, 7 + Col)
        End If
9        If Arr(J, 8 + Col) <> Space(0) Then
            aDg(9, 1) = aDg(9, 1) + 1:                  aKQ8(aDg(9, 1), 1) = Arr(J, 3)
            aKQ8(aDg(9, 1), 2) = Arr(J, 8 + Col)
        End If
10       If Arr(J, 9 + Col) <> Space(0) Then
            aDg(10, 1) = aDg(10, 1) + 1:                  aKQ9(aDg(10, 1), 1) = Arr(J, 3)
            aKQ9(aDg(10, 1), 2) = Arr(J, 9 + Col)
        End If
    Next J
    [A5].Resize(aDg(1, 1), 3) = aKQ0():             [e5].Resize(aDg(2, 1), 2).Value = aKQ1()
    [I5].Resize(aDg(3, 1), 2).Value = aKQ2():       [M5].Resize(aDg(4, 1), 2).Value = aKQ3()
    [Q5].Resize(aDg(5, 1), 2).Value = aKQ4():       [U5].Resize(aDg(6, 1), 2).Value = aKQ5()
    [Y5].Resize(aDg(7, 1), 2).Value = aKQ6():       [AC5].Resize(aDg(8, 1), 2).Value = aKQ7()
    [AG5].Resize(aDg(9, 1), 2).Value = aKQ8():      [Ak5].Resize(aDg(10, 1), 2).Value = aKQ9()
'Xác Dinh Dòng Có Du Liêu   '
    For J = 1 To 10
        If aDg(J, 1) > rMax Then rMax = aDg(J, 1)
    Next J
    Rows(rMax + 6 & ":99").Hidden = True
    Application.ScreenUpdating = True
    MsgBox "Xong Rôi Nha!", , "GPE.COM Xin Chào! " & rMax
 End If
End Sub

Bích Tỷ · 14/4/22

SA_DQ đã viết:

Macro sự kiện cho mươi ngày của bạn đây, Kiểm tất cả xem sao(?)

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Col As Integer, Rws As Long, J As Long, rMax As Integer
 Dim W1 As Integer, W5 As Integer, W9 As Integer, W7 As Integer, W0 As Integer
 Dim W3 As Integer, W4 As Integer, W6 As Integer, W8 As Integer, W2 As Integer
 Dim Sh As Worksheet, Cls As Range, Rng As Range, Arr()
 Const B2_ As Integer = 6:                      Const D2_ As Double = 1.2
' On Error Resume Next  '
 If Not Intersect(Target, [A2]) Is Nothing Then
    Set Sh = ThisWorkbook.Worksheets("KeHoach")
    Rws = Sh.[C2].CurrentRegion.Rows.Count
    [A30:AN99].ClearContents
'Tìm Ngày Bát Dàu:      '
    For Each Cls In Sh.Range(Sh.[h1], Sh.[h1].End(xlToRight))
        If Cls.Value = Target.Value Then
            Col = Cls.Column:                Arr() = Sh.[A2].Resize(Rws, 9 + Col).Value
            Exit For
        End If
    Next Cls
    ReDim aKQ0(1 To 99, 1 To 3):            ReDim aKQ1(1 To 99, 1 To 2)
    ReDim aKQ2(1 To 99, 1 To 2):            ReDim aKQ3(1 To 99, 1 To 2)
    ReDim aKQ4(1 To 99, 1 To 2):            ReDim aKQ5(1 To 99, 1 To 2)
    ReDim aKQ6(1 To 99, 1 To 2):            ReDim aKQ7(1 To 99, 1 To 2)
    ReDim aKQ9(1 To 99, 1 To 2):            ReDim aKQ8(1 To 99, 1 To 2)
    ReDim aDg(1 To 10, 1 To 1) As Integer
 
    Rows("5:99").Hidden = False:            [A5].Resize(95, 40).ClearContents
    Application.ScreenUpdating = False
   For J = 1 To UBound(Arr())
1        If Arr(J, Col) <> Space(0) Then
            aDg(1, 1) = aDg(1, 1) + 1:      aKQ0(aDg(1, 1), 1) = Arr(J, 3)
            aKQ0(aDg(1, 1), 2) = Arr(J, Col)
            aKQ0(aDg(1, 1), 3) = Arr(J, Col) / B2_ / D2_ / 8
        End If
2        If (Arr(J, 1 + Col)) <> Space(0) Then
            aDg(2, 1) = aDg(2, 1) + 1
            aKQ1(aDg(2, 1), 1) = Arr(J, 3)
            aKQ1(aDg(2, 1), 2) = Arr(J, 1 + Col)
        End If
3        If (Arr(J, 2 + Col)) <> Space(0) Then
            aDg(3, 1) = aDg(3, 1) + 1:                  aKQ2(aDg(3, 1), 1) = Arr(J, 3)
            aKQ2(aDg(3, 1), 2) = Arr(J, 2 + Col)
        End If
4        If Arr(J, 3 + Col) <> Space(0) Then
            aDg(4, 1) = aDg(4, 1) + 1:                  aKQ3(aDg(4, 1), 1) = Arr(J, 3)
            aKQ3(aDg(4, 1), 2) = Arr(J, 3 + Col)
        End If
5        If Arr(J, 4 + Col) <> Space(0) Then
            aDg(5, 1) = aDg(5, 1) + 1:                  aKQ4(aDg(5, 1), 1) = Arr(J, 3)
            aKQ4(aDg(5, 1), 2) = Arr(J, 4 + Col)
        End If
6        If Arr(J, 5 + Col) <> Space(0) Then
            aDg(6, 1) = aDg(6, 1) + 1:                  aKQ5(aDg(6, 1), 1) = Arr(J, 3)
            aKQ5(aDg(6, 1), 2) = Arr(J, 5 + Col)
        End If
7        If Arr(J, 6 + Col) <> Space(0) Then
            aDg(7, 1) = aDg(7, 1) + 1:                  aKQ6(aDg(7, 1), 1) = Arr(J, 3)
            aKQ6(aDg(7, 1), 2) = Arr(J, 6 + Col)
        End If
8        If Arr(J, 7 + Col) <> Space(0) Then
            aDg(8, 1) = aDg(8, 1) + 1:                  aKQ7(aDg(8, 1), 1) = Arr(J, 3)
            aKQ7(aDg(8, 1), 2) = Arr(J, 7 + Col)
        End If
9        If Arr(J, 8 + Col) <> Space(0) Then
            aDg(9, 1) = aDg(9, 1) + 1:                  aKQ8(aDg(9, 1), 1) = Arr(J, 3)
            aKQ8(aDg(9, 1), 2) = Arr(J, 8 + Col)
        End If
10       If Arr(J, 9 + Col) <> Space(0) Then
            aDg(10, 1) = aDg(10, 1) + 1:                  aKQ9(aDg(10, 1), 1) = Arr(J, 3)
            aKQ9(aDg(10, 1), 2) = Arr(J, 9 + Col)
        End If
    Next J
    [A5].Resize(aDg(1, 1), 3) = aKQ0():             [e5].Resize(aDg(2, 1), 2).Value = aKQ1()
    [I5].Resize(aDg(3, 1), 2).Value = aKQ2():       [M5].Resize(aDg(4, 1), 2).Value = aKQ3()
    [Q5].Resize(aDg(5, 1), 2).Value = aKQ4():       [U5].Resize(aDg(6, 1), 2).Value = aKQ5()
    [Y5].Resize(aDg(7, 1), 2).Value = aKQ6():       [AC5].Resize(aDg(8, 1), 2).Value = aKQ7()
    [AG5].Resize(aDg(9, 1), 2).Value = aKQ8():      [Ak5].Resize(aDg(10, 1), 2).Value = aKQ9()
'Xác Dinh Dòng Có Du Liêu   '
    For J = 1 To 10
        If aDg(J, 1) > rMax Then rMax = aDg(J, 1)
    Next J
    Rows(rMax + 6 & ":99").Hidden = True
    Application.ScreenUpdating = True
    MsgBox "Xong Rôi Nha!", , "GPE.COM Xin Chào! " & rMax
 End If
End Sub

Anh ơi, sau khi em làm thử thì có 3 vấn đề anh ạ. (Như em mô tả ở bài #7)
=> cột 8h: Số lượng/6(ô B2)/ô D2/8/ trung bình tiêu chuẩn(*)
=> cột 9.5h: Số lượng/6(ô B2)/ô D2/9.5/ trung bình tiêu chuẩn(**)
1. Chưa có chia theo tiêu chuẩn nữa anh
2. Ô B2 và ô D2 di chuyển theo từng tuần (Số lượng có thể khác), nên anh thay đổi dữ liệu điều kiện trong code giúp em với ạ.
3. Chưa có tính tổng theo TEN GIAY anh ạ (TEN GIAY còn trùng nhau). em cảm ơn

SA_DQ · 14/4/22

Macro này sẽ tổng hợp số liệu mươi ngày, tính từ ô [A2] & hiện chỉ 2 cột

PHP:

Sub TongHopTheoNgay()
 Dim Arr(), Dic As Object, Sh As Worksheet, Cls As Range
 Dim Rws As Long, J As Long, Col As Integer, Cot As Integer, W As Integer, MaxR As Integer
 Dim SKey As String

 Set Dic = CreateObject("Scripting.Dictionary")
 Set Sh = ThisWorkbook.Worksheets("KeHoach")
 Rws = Sh.[C2].CurrentRegion.Rows.Count
 Sheets("Chat").Select
 [A5:AN99].ClearContents:                               Rows("5:99").Hidden = False
 For Each Cls In Sh.Range(Sh.[h1], Sh.[h1].End(xlToRight))
    If Cls.Value = [A2].Value Then
        Col = Cls.Column:                               Exit For
    End If
 Next Cls
 For Cot = 0 To 9
    Arr() = Sh.Range(Sh.[C2], Sh.Cells(2, 10 + Col)).Resize(Rws).Value
    Set Dic = CreateObject("Scripting.Dictionary")
    ReDim aKQ(1 To 99, 1 To 4):                         W = 0
    For J = 1 To UBound(Arr())
        SKey = Arr(J, 1)
        If Arr(J, Cot + Col - 2) <> Space(0) Then
        If Not Dic.Exists(Arr(J, 1)) Then
            W = W + 1:                                  aKQ(W, 1) = Arr(J, 1)
            aKQ(W, 2) = Arr(J, Cot + Col - 2):          Dic.Add SKey, W
        Else
            aKQ(Dic.Item(SKey), 2) = aKQ(Dic.Item(SKey), 2) + Arr(J, Cot + Col - 2)
        End If
        End If
    Next J
    Cells(5, 4 * Cot + 1).Resize(W, 2) = aKQ()
    If MaxR < W Then MaxR = W
 Next Cot
 Rows(MaxR + 6 & ":99").Hidden = True
End Sub

Bích Tỷ · 14/4/22

SA_DQ đã viết:

Macro này sẽ tổng hợp số liệu mươi ngày, tính từ ô [A2] & hiện chỉ 2 cột

PHP:

Sub TongHopTheoNgay()
 Dim Arr(), Dic As Object, Sh As Worksheet, Cls As Range
 Dim Rws As Long, J As Long, Col As Integer, Cot As Integer, W As Integer, MaxR As Integer
 Dim SKey As String

 Set Dic = CreateObject("Scripting.Dictionary")
 Set Sh = ThisWorkbook.Worksheets("KeHoach")
 Rws = Sh.[C2].CurrentRegion.Rows.Count
 Sheets("Chat").Select
 [A5:AN99].ClearContents:                               Rows("5:99").Hidden = False
 For Each Cls In Sh.Range(Sh.[h1], Sh.[h1].End(xlToRight))
    If Cls.Value = [A2].Value Then
        Col = Cls.Column:                               Exit For
    End If
 Next Cls
 For Cot = 0 To 9
    Arr() = Sh.Range(Sh.[C2], Sh.Cells(2, 10 + Col)).Resize(Rws).Value
    Set Dic = CreateObject("Scripting.Dictionary")
    ReDim aKQ(1 To 99, 1 To 4):                         W = 0
    For J = 1 To UBound(Arr())
        SKey = Arr(J, 1)
        If Arr(J, Cot + Col - 2) <> Space(0) Then
        If Not Dic.Exists(Arr(J, 1)) Then
            W = W + 1:                                  aKQ(W, 1) = Arr(J, 1)
            aKQ(W, 2) = Arr(J, Cot + Col - 2):          Dic.Add SKey, W
        Else
            aKQ(Dic.Item(SKey), 2) = aKQ(Dic.Item(SKey), 2) + Arr(J, Cot + Col - 2)
        End If
        End If
    Next J
    Cells(5, 4 * Cot + 1).Resize(W, 2) = aKQ()
    If MaxR < W Then MaxR = W
 Next Cot
 Rows(MaxR + 6 & ":99").Hidden = True
End Sub

em mới làm thử là đã bỏ được dữ liệu trùng.
Còn phần tính toán ở cột 8h(Cột C) và 9.5h (Cột D) thì như thế nào anh ạ và chạy hết 10 tuần sẽ như thế nào anh. phiên anh hỗ trợ ạ

biboylenka1 · 14/4/22

SA_DQ đã viết:
1 If Arr(J, Col) <> Space(0) Then

Chú ơi cho cháu hỏi mấy cái số đánh ở đầu dòng này ý nghĩa và tác dụng của nó là gì thế ạ?

SA_DQ · 14/4/22

Bích Tỷ đã viết:
em mới làm thử là đã bỏ được dữ liệu trùng.
Còn phần tính toán ở cột 8h(Cột C) và 9.5h (Cột D) thì như thế nào anh ạ và chạy hết 10 tuần sẽ như thế nào anh. phiên anh hỗ trợ ạ

(1) Đã có kết quả mươi ngày rồi mà, ở cột [Số lương]

Còn đây là số liệu cột thứ 3 của ngày đầu tiên trong bảng dữ liệu, bạn xem & kiểm thử:

Tên Giày	Số lượng	H/ngày
Tumbleweed/Espresso	132	0.16
Vibrant Violet/Stucco	9168	0.80
Khaki/Stucco	25680	2.23
Black/Light Grey	12498	1.08
Charcoal/Light Grey	6982	1.06
Dusty olive/Cobblestone	5144	0.45
Navy/Stucco	8824	0.77
Black/Smoke	10010	2.07
Chocolate/Hazelnut	14513	1.26
Light Grey/White	1930	0.76
Black/Black	2591	0.54
Khaki/Espresso	7272	0.63
Charcoal/Stucco	126	0.01
Khaki/Walnut	11432	4.33
Smoke/Buttercup	36	0.00
espresso/espresso	966	0.35
khaki/mushroom	8286	2.12
Navy/White	1022	0.40
Navy/Light Grey	4929	0.52
Pool/Viola	1131	0.25
Nautical navy/Wild orchid	168	0.12

biboylenka1 đã viết:
biboylenka1 đã viết:

Chú ơi cho cháu hỏi mấy cái số đánh ở đầu dòng này ý nghĩa và tác dụng của nó là gì thế ạ?

Nhấp chuột vào đây để mở rộng...

Các con số đó:
a./ VBA cho phép, miễn là không trùng
b./ VBA cung cấp cho ta hàm Erl() để cho ta biết dòng (đã được ta đánh số) nào đang chứa lỗi;
Tuy nhiên cũng cần lưu í rằng, có thể lỗi ở các dòng lệnh trên/trước nó

Bích Tỷ · 15/4/22

SA_DQ đã viết:
(1) Đã có kết quả mươi ngày rồi mà, ở cột [Số lương]

Còn đây là số liệu cột thứ 3 của ngày đầu tiên trong bảng dữ liệu, bạn xem & kiểm thử:

Tên Giày Số lượng H/ngày
Tumbleweed/Espresso 132 0.16
Vibrant Violet/Stucco 9168 0.80
Khaki/Stucco 25680 2.23
Black/Light Grey 12498 1.08
Charcoal/Light Grey 6982 1.06
Dusty olive/Cobblestone 5144 0.45
Navy/Stucco 8824 0.77
Black/Smoke 10010 2.07
Chocolate/Hazelnut 14513 1.26
Light Grey/White 1930 0.76
Black/Black 2591 0.54
Khaki/Espresso 7272 0.63
Charcoal/Stucco 126 0.01
Khaki/Walnut 11432 4.33
Smoke/Buttercup 36 0.00
espresso/espresso 966 0.35
khaki/mushroom 8286 2.12
Navy/White 1022 0.40
Navy/Light Grey 4929 0.52
Pool/Viola 1131 0.25
Nautical navy/Wild orchid 168 0.12

Các con số đó:
a./ VBA cho phép, miễn là không trùng
b./ VBA cung cấp cho ta hàm Erl() để cho ta biết dòng (đã được ta đánh số) nào đang chứa lỗi;
Tuy nhiên cũng cần lưu í rằng, có thể lỗi ở các dòng lệnh trên/trước nó

Anh ơi, sao em bỏ code (sub) của anh vào thì lại không ra số giống với cái bảng này của anh. anh chưa đính kèm code hả anh.

SA_DQ · 15/4/22

Bích Tỷ đã viết:
Anh ơi, sao em bỏ code (sub) của anh vào thì lại không ra số giống với cái bảng này của anh. anh chưa đính kèm code hả anh.

Bấm vô hình mũi tên sau khi chọn ngày, bạn sẽ nhận được kết quả từ macro

$$$$@

Bích Tỷ · 15/4/22

SA_DQ đã viết:
Bấm vô hình mũi tên sau khi chọn ngày, bạn sẽ nhận được kết quả từ macro

Cảm ơn anh rất nhiều

SA_DQ · 15/4/22

3 Trang tính 'Chat', 'Dem' & 'In' có số liệu giống na na nhau, chỉ khác cách tính lấy số liệu 'TieuChuan' ở 3 cột khác nhau của trang 'TieuChuan' mà thôi;
Chuyện này cho phép ta gộp lên 1 trang tính, trang này sẽ thể hiện kết quả theo lựa chọn của ta cần vế 'Chat', 'In' hay 'Dem'
???

SA_DQ · 16/4/22

Chọn 1 trong 3 tiêu chí tại [O2] của trang 'CID' & kiểm theo kết quả giúp xem sao nha:

Bích Tỷ · 18/4/22

SA_DQ đã viết:
Chọn 1 trong 3 tiêu chí tại [O2] của trang 'CID' & kiểm theo kết quả giúp xem sao nha:

Cảm ơn anh. em xem và có chỉnh sửa code cho 2 sheet CHUANBI và GCD cho ra kết quả em cần ạ.

Bích Tỷ · 18/4/22

SA_DQ đã viết:
Chọn 1 trong 3 tiêu chí tại [O2] của trang 'CID' & kiểm theo kết quả giúp xem sao nha:

Chào anh, em còn 1 sheet May và Thành hình chưa xử lý được ạ.
- Sau khi lấy được: Chuyen, MaGiay, TenGiay và SoLuong thì kế tiếp là cần lấy DOI/H và SoNguoi
+ Cột DOI/H: dựa vào chuyền và tên giày để tìm số DOI/H từ sheet TC2(doi/h).
+ Cột SoNguoi: dựa vào tên giay và cột DOI/H để tìm số ra số người ở sheet TIEUCHUAN (*)'

(*) Có 2 cột may và thành hình có mỗi DOI/H, cột may thì dành cho sheet May, thành hinh dành cho sheet thanhhinh
=> nếu sối DOI/H không tồn tại ở sheet TIEUCHUAN thì lấy số người ở cột kế tiếp (Số đôi/h lớn hơn gần nhất với số DOI/H không tồn tại). Em cảm ơn

SA_DQ · 18/4/22

Bích Tỷ đã viết:
Chào anh, em còn 1 sheet May và . . . . . .
- Sau khi lấy được: Chuyen, MaGiay, TenGiay và SoLuong thì kế tiếp là cần lấy DOI/H và . . .

Thì cho macro này chạy & kiểm tra số liệu:

PHP:

Sub TinhDoiGio()
 Dim Cot As Integer, Dg As Integer, Rws As Long, Col As Integer
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Chuyen As String, Ten As String
 
 Set Sh = Sheet3
 Rws = Sh.[B2].CurrentRegion.Rows.Count
 Set Rng = Sh.[B1].Resize(Rws)
 Sheets("May").Select
 Application.ScreenUpdating = False
 For Cot = 1 To 60 Step 6
    Rws = Cells(99, Cot).End(xlUp).Row
    For Dg = 5 To Rws
        Chuyen = Cells(Dg, Cot).Value
        Col = Asc(Chuyen) - 64
        Ten = Cells(Dg, 2 + Cot).Value
        Set sRng = Rng.Find(Ten, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            Cells(Dg, 2 + Cot).Interior.ColorIndex = 38
        Else
            Cells(Dg, 4 + Cot).Value = sRng.Offset(, Col).Value
        End If
    Next Dg
 Next Cot
Application.ScreenUpdating = True
End Sub

Bích Tỷ · 19/4/22

Bích Tỷ đã viết:
+ Cột SoNguoi (Cột F): dựa vào tên giay và cột DOI/H để tìm số ra số người ở sheet TIEUCHUAN (*)'

(*) Có 2 cột may và thành hình có mỗi DOI/H, cột may thì dành cho sheet May, thành hinh dành cho sheet thanhhinh
=> nếu sối DOI/H không tồn tại ở sheet TIEUCHUAN thì lấy số người ở cột kế tiếp (Số đôi/h lớn hơn gần nhất với số DOI/H không tồn tại). Em cảm ơn

Chào anh SA_DQ cột DOI/H ra kết quả đúng rồi anh, còn cột số người thì xử ly sao anh. em cảm ơn

SA_DQ · 19/4/22

Thử cái ni & cho biết rùa cỡ nào!

PHP:

Sub TinhNhanLuc()
 Dim Cot As Integer, Rws As Integer, Dg As Integer, DoiG As Integer, Col As Integer
 Dim J As Integer
 Dim Arr(), Rng As Range, sRng As Range
 Dim Ten As String
 
 With Sheets("TieuChuan")
    Cot = .[BB2].End(xlToRight).Column
    Arr() = .Range(.[BB2], .Cells(2, Cot)).Resize(4).Value
    Rws = .[b5].CurrentRegion.Rows.Count
    Set Rng = .[b5].Resize(Rws)
 End With
 Application.ScreenUpdating = False
 Sheets("May").Select
 For Cot = 3 To 57 Step 6   'Duyêt Theo Côt '
    Rws = Cells(99, Cot).End(xlUp).Row  'Dòng Cuôi DL Các Ngày  '
    For Dg = 5 To Rws   'Duyêt Các Dòng Theo Tùng Ngày  '
        Ten = Cells(Dg, Cot).Value
        DoiG = Cells(Dg, 2 + Cot).Value
        Cells(Dg, 3 + Cot).Value = Space(0)
        For J = 1 To UBound(Arr(), 2)
            If Arr(1, J) = DoiG Then
                Col = Arr(4, J):        Exit For
            End If
        Next J
        Set sRng = Rng.Find(Ten, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            Cells(Dg, 3 + Cot).Value = Sheets("TieuChuan").Cells(sRng.Row, Col).Value
        End If
    Next Dg
 Next Cot
 Application.ScreenUpdating = True
 MsgBox "Tính Xong Rôi", , "GPE.COM Xin Chào!"
End Sub

Bích Tỷ · 19/4/22

SA_DQ đã viết:

Thử cái ni & cho biết rùa cỡ nào!

PHP:

Sub TinhNhanLuc()
 Dim Cot As Integer, Rws As Integer, Dg As Integer, DoiG As Integer, Col As Integer
 Dim J As Integer
 Dim Arr(), Rng As Range, sRng As Range
 Dim Ten As String
 
 With Sheets("TieuChuan")
    Cot = .[BB2].End(xlToRight).Column
    Arr() = .Range(.[BB2], .Cells(2, Cot)).Resize(4).Value
    Rws = .[b5].CurrentRegion.Rows.Count
    Set Rng = .[b5].Resize(Rws)
 End With
 Application.ScreenUpdating = False
 Sheets("May").Select
 For Cot = 3 To 57 Step 6   'Duyêt Theo Côt '
    Rws = Cells(99, Cot).End(xlUp).Row  'Dòng Cuôi DL Các Ngày  '
    For Dg = 5 To Rws   'Duyêt Các Dòng Theo Tùng Ngày  '
        Ten = Cells(Dg, Cot).Value
        DoiG = Cells(Dg, 2 + Cot).Value
        Cells(Dg, 3 + Cot).Value = Space(0)
        For J = 1 To UBound(Arr(), 2)
            If Arr(1, J) = DoiG Then
                Col = Arr(4, J):        Exit For
            End If
        Next J
        Set sRng = Rng.Find(Ten, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            Cells(Dg, 3 + Cot).Value = Sheets("TieuChuan").Cells(sRng.Row, Col).Value
        End If
    Next Dg
 Next Cot
 Application.ScreenUpdating = True
 MsgBox "Tính Xong Rôi", , "GPE.COM Xin Chào!"
End Sub

Cảm ơn anh rất nhiều. em có chỉnh sửa lại một số chỗ trong code và em đã áp dụng để hoàn thành file dữ liệu.

Bích Tỷ · 27/5/22

SA_DQ đã viết:

PHP:

Sub TinhDoiGio()
 Dim Cot As Integer, Dg As Integer, Rws As Long, Col As Integer
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim Chuyen As String, Ten As String
 
 Set Sh = Sheet3
 Rws = Sh.[B2].CurrentRegion.Rows.Count
 Set Rng = Sh.[B1].Resize(Rws)
 Sheets("May").Select
 Application.ScreenUpdating = False
 For Cot = 1 To 60 Step 6
    Rws = Cells(99, Cot).End(xlUp).Row
    For Dg = 5 To Rws
        Chuyen = Cells(Dg, Cot).Value
        Col = Asc(Chuyen) - 64
        Ten = Cells(Dg, 2 + Cot).Value
        Set sRng = Rng.Find(Ten, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            Cells(Dg, 2 + Cot).Interior.ColorIndex = 38
        Else
            Cells(Dg, 4 + Cot).Value = sRng.Offset(, Col).Value
        End If
    Next Dg
 Next Cot
Application.ScreenUpdating = True
End Sub

Dạ chào anh @SA_DQ , sau một thời gian sử dụng em có thay đổi tên CHUYỀN thì kết quả trả về hoàn toàn sai. phiền anh xem giúp em, em cảm ơn.
-Dữ liệu bảng tiêu chuẩn:

- kết quả sheet MAY:

Bích Tỷ · 28/5/22

Bích Tỷ đã viết:
Dạ chào anh @SA_DQ , sau một thời gian sử dụng em có thay đổi tên CHUYỀN thì kết quả trả về hoàn toàn sai. phiền anh xem giúp em, em cảm ơn.
-Dữ liệu bảng tiêu chuẩn:
View attachment 276546
- kết quả sheet MAY:
View attachment 276547

Dạ, mong anh @SA_DQ hỗ trợ giúp em vợi ạ, cảm ơn anh nhiều

Tính số nhân công (1 người xem)

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

Thành viên chính thức

File đính kèm

Thành viên gạo cội

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

Thành viên hay hỏi

/(hông là gì!

Thành viên chính thức

/(hông là gì!

File đính kèm

Thành viên chính thức

/(hông là gì!

/(hông là gì!

File đính kèm

Thành viên chính thức

Thành viên chính thức

File đính kèm

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên chính thức

Thời gian đếm ngược.