Gỏ Mã Công đoạn, dò theo mã hàng lấy tên công đoạn

NguyenthiH · 19/12/16

Chào các AC, em lại làm phiền các AC giúp em ah!
Trong File em có tạo Form, và có Các Anh HieuCD, ChanhTQ@.. vv. đã giúp em, nhưng vì có thay đổi(Thêm cột mã công đoạn), mong các Anh giúp em lần nữa.
Trong File Khi em gỏ mã công đoạn trong Tb_MCD, thì sẽ dò theo Mã Hàng và lấy tên công đoạn đập vào Tb_CD.
Em xin ví dụ như sau:
1/em chọn mã hàng là VL2335, gỏ mã công đoạn là 1, thì sẽ lấy tên công đoạn " Ủỉ Ly" đập vào Tb_CD.
2/em chọn mã hàng là Q1M528S0, gỏ mã công đoạn là 1, thì sẽ lấy tên công đoạn "May Túi" đập vào Tb_CD
(Sẽ có trùng mã công đoạn, nhưng khác tên mã hàng)
Nếu gỏ mã công đoạn không có trong mã hàng, thì sẽ có MsgBox báo lỗi. Ví dụ như:
1/Mã hàng VL2335 có mã CD từ 1->7, mà gỏ 8 thì báo lỗi.
2/Mã hàng Q1M528S0 có mã CD từ 1->8, gỏ 9 thì báo lỗi.
Em cũng nhờ các Anh giúp em lọc ra bảng chi tiết công nhân làm gì trong tháng (Sheet!4).(Gỏ tháng vào Sheet4!2 và Tổ vào Sheet4!B2 và Tên công nhân vào Shet4!C2 thì hiện chi tiết của công nhân đó vào bảng chi tiết: sheet4!A5

.
Em chân thành cám ơn.

NguyenthiH · 19/12/16

Xin Anh HieuCD chỉnh lại dùm code "ThanhTien". Vì chèn thêm cột mã công đoạn nên giờ code "ThanhTien" bị lỗi.
Mong Anh giúp đỡ.

HieuCD · 19/12/16

NguyenthiH đã viết:
Xin Anh HieuCD chỉnh lại dùm code "ThanhTien". Vì chèn thêm cột mã công đoạn nên giờ code "ThanhTien" bị lỗi.
Mong Anh giúp đỡ.

Code mới

Mã:

Sub ThanhTien()
Dim Dic As Object, Darr(), Darr2(), Arr(), i As Long, tmp As String
If Sheets("Sheet2").Range("B65500").End(xlUp).Row <= 3 Or Sheets("Sheet1").Range("A65500").End(xlUp).Row <= 3 Then Exit Sub
Set Dic = CreateObject("Scripting.Dictionary")
Darr = Sheets("Sheet1").Range([COLOR=#ff0000]"A4:D"[/COLOR] & Sheets("Sheet1").Range("A65500").End(xlUp).Row).Value
For i = 1 To UBound(Darr)
    tmp = Darr(i, 1) & "!@#" & Darr(i, 2)
    If Not Dic.exists(tmp) Then Dic.Add tmp, Darr(i, [COLOR=#ff0000]4[/COLOR])
Next i
Darr = Sheets("Sheet2").Range("D4:F" & Sheets("Sheet2").Range("B65500").End(xlUp).Row).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
For i = 1 To UBound(Darr)
    tmp = Darr(i, 1) & "!@#" & Darr(i, 2)
    If Dic.exists(tmp) Then Arr(i, 1) = Darr(i, 3) * Dic.Item(tmp)
Next i
Set Dic = Nothing
Sheets("Sheet2").Range("G4:G" & Sheets("Sheet2").Range("B65500").End(xlUp).Row).Value = Arr
Range("A4").Select
End Sub

NguyenthiH · 19/12/16

Em cũng chỉnh gần giống Anh (Vì không biết VBA, chỉ thấy thêm một cột thì cho nó bằng 4 hết)
Sai chổ này:

Mã:

For i = 1 To UBound(Darr)
    tmp = Darr(i, 1) & "!@#" & Darr(i, 2)
    If Dic.exists(tmp) Then Arr(i, 1) = Darr(i, [B][COLOR=#ff0000]4[/COLOR][/B]) * Dic.Item(tmp)
Next i[code]
Mong Anh giúp em phần còn lại.

ChanhTQ@ · 19/12/16

Bạn tham khảo cái này trong khi chờ đợi.

[thongbao]Mong Anh giúp em phần còn lại.[/thongbao]

NguyenthiH · 19/12/16

File của Anh ChanhTQ@ cũng chưa đúng, Sao Nguyễn văn Thể làm MOR5147 -Vắt Lai-9 mà thành tiền là 0.
Mong các Anh giúp đỡ Form dùm em nữa.

NguyenthiH · 19/12/16

Code cho sheet chi tiết ỏ shet4 dùng Advanced Filter (VBA) được không các Anh(Em mù về VBA).

HieuCD · 19/12/16

NguyenthiH đã viết:
Em cũng chỉnh gần giống Anh (Vì không biết VBA, chỉ thấy thêm một cột thì cho nó bằng 4 hết)
Sai chổ này:

Mã:

For i = 1 To UBound(Darr) tmp = Darr(i, 1) & "!@#" & Darr(i, 2) If Dic.exists(tmp) Then Arr(i, 1) = Darr(i, [B][COLOR=#ff0000]4[/COLOR][/B]) * Dic.Item(tmp) Next i[code] Mong Anh giúp em phần còn lại.[/QUOTE] bạn kiểm tra lại file, mình thay đổi nhiều sub

ChanhTQ@ · 19/12/16

File của Anh ChanhTQ@ cũng chưa đúng;
Sao Nguyễn văn Thể làm MOR5147 -Vắt Lai-9 mà thành tiền là 0.
Mong các Anh giúp đỡ Form dùm em nữa.

Cái này do lịch sử để lại;

Tại ô [M6] của trang 'CTiet' đang chứa trị là 0; Nếu bạn sửa trị này thành con số nào đó mà bạn iêu thích & chạy lại macro sẽ thấy khác thôi.

NguyenthiH · 19/12/16

Cám Ơn Anh HieuCD, trong cột mã công đoạn của em có cả giá trị kiểu Số và Kiểu Text như 1 và 1a thì chỉnh sub Cb_CD_Change lại làm sao Anh, hay mình convert thành chuỗi hết như bài trước.

Mã:

Private Sub cb_CD_Change()
Dim lastRow As Long, r As Long, Arr(), MH As String, MCD
    MH = Cb_MH.Value:       MCD = Val(Cb_CD.Value)
    With Sheet1
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        If lastRow < 3 Then Exit Sub
        Arr = .Range("A4:C" & lastRow).Value
    End With
    For r = 1 To UBound(Arr)
        If Arr(r, 1) = MH And Arr(r, 3) = MCD Then
            Tb_CD.Text = Arr(r, 2)
            Exit Sub
        End If
    Next r
MsgBox "Không có Ma công doan"
End Sub

và cho em hỏi name "TenCD" của Anh là gỏ vào hả Anh, nếu vậy thêm tổ thì cứ gỏ vào hả Anh??? có cách nào lấy tự động không???
và chỉ cho em cách coppy công thức ở name sang name khác với Anh,

HieuCD · 19/12/16

NguyenthiH đã viết:
Cám Ơn Anh HieuCD, trong cột mã công đoạn của em có cả giá trị kiểu Số và Kiểu Text như 1 và 1a thì chỉnh sub Cb_CD_Change lại làm sao Anh, hay mình convert thành chuỗi hết như bài trước.

Mã:

Private Sub cb_CD_Change() Dim lastRow As Long, r As Long, Arr(), MH As String, MCD MH = Cb_MH.Value: MCD = Val(Cb_CD.Value) With Sheet1 lastRow = .Cells(Rows.Count, "A").End(xlUp).Row If lastRow < 3 Then Exit Sub Arr = .Range("A4:C" & lastRow).Value End With For r = 1 To UBound(Arr) If Arr(r, 1) = MH And Arr(r, 3) = MCD Then Tb_CD.Text = Arr(r, 2) Exit Sub End If Next r MsgBox "Không có Ma công doan" End Sub

và cho em hỏi name "TenCD" của Anh là gỏ vào hả Anh, nếu vậy thêm tổ thì cứ gỏ vào hả Anh??? có cách nào lấy tự động không???
và chỉ cho em cách coppy công thức ở name sang name khác với Anh,

sub xet mã công đoạn theo chuỗi

Mã:

Private Sub cb_CD_Change()
Dim lastRow As Long, r As Long, Arr(), MH As String, MCD
    MH = Cb_MH.Value:       MCD = Cb_CD.Value
    With Sheet1
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        If lastRow < 3 Then Exit Sub
        Arr = .Range("A4:C" & lastRow).Value
    End With
    For r = 1 To UBound(Arr)
        If Arr(r, 1) = MH And Arr(r, 3) & "" = MCD Then
            Tb_CD.Text = Arr(r, 2)
            Exit Sub
        End If
    Next r
MsgBox "Không có Ma công doan"
End Sub

name là mình nhập tay vào
khi thêm tổ mới phải chỉnh lại name Tocn
name TenCN , khi thêm công nhân mới, hoặc tổ mới, cứ nhập vào dòng ngay phía dưới bảng, quan trọng là phải xếp thứ tự theo tổ. nếu không xếp thì kết quả sẽ sai, lúc đó phải dùng thêm cột phụ và dùng công thức hoặc dùng code VBA để tạo vùng TenCN

NguyenthiH · 19/12/16

Cám Ơn Anh HieuCD nhiều nhiều!!! **~**

NguyenthiH · 26/12/16

Anh HieuCD có thể giúp em tính tổng thành tiền ở cột D của sheet4 giúp em với.
Em xin ví dụ như : chọn tháng 11, tổ 1, tên CN là Hồ Thị Đào thì sẽ có D5=4272, D6=4170, D7=7416, D8=3055, thì C9 có chữ "Tổng Tiền", và D9 là 18913.
Tất nhiên là các công nhân khác thì "Tổng Tiền" sẽ không là C9 và D9 nữa mà là C10 và D10 hay là C13 và D13..vvv....v. vì theo số lượng công đoạn mà họ làm được.
Mong Anh giúp.

HieuCD · 26/12/16

NguyenthiH đã viết:
Anh HieuCD có thể giúp em tính tổng thành tiền ở cột D của sheet4 giúp em với.
Em xin ví dụ như : chọn tháng 11, tổ 1, tên CN là Hồ Thị Đào thì sẽ có D5=4272, D6=4170, D7=7416, D8=3055, thì C9 có chữ "Tổng Tiền", và D9 là 18913.
Tất nhiên là các công nhân khác thì "Tổng Tiền" sẽ không là C9 và D9 nữa mà là C10 và D10 hay là C13 và D13..vvv....v. vì theo số lượng công đoạn mà họ làm được.
Mong Anh giúp.

bạn thay code mới

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:C2")) Is Nothing Then
    If Sheets("Sheet2").Range("B65500").End(xlUp).Row <= 3 Then Exit Sub
    Dim Darr(), Arr(), i As Long, j As Byte, thang As Byte, tocn, tencn As String, tt As Double
    Darr = Sheets("Sheet2").Range("A4:G" & Sheets("Sheet2").Range("A65500").End(xlUp).Row).Value
    ReDim Arr(1 To UBound(Darr), 1 To 4)
    thang = Range("A2").Value: tocn = Range("B2").Value: tencn = Range("C2").Value
    For i = 1 To UBound(Darr)
        If Month(Darr(i, 1)) = thang And Darr(i, 2) = tencn And Darr(i, 3) = tocn Then
            k = k + 1
            For j = 1 To 4
                Arr(k, j) = Darr(i, j + 3)
            Next j
            [COLOR=#ff0000]tt = tt + Arr(k, 4)[/COLOR]
        End If
    Next i
    Sheets("Sheet4").Range("A5:D1000").Clear
    If k > 0 Then
        Sheets("Sheet4").Range("A5").Resize(k, 4) = Arr
[COLOR=#ff0000]        Sheets("Sheet4").Range("C5").Offset(k, 0) = Range("B1") & "ng " & Range("D4")[/COLOR]
[COLOR=#ff0000]        Sheets("Sheet4").Range("D5").Offset(k, 0) = tt[/COLOR]
[COLOR=#ff0000]        Sheets("Sheet4").Range("A4").Resize(k + 2, 4).Borders.LineStyle = 1[/COLOR]
    End If
End If
End Sub

NguyenthiH · 26/12/16

Cám Ơn Anh HieuCD nhiều nhiều.

NguyenthiH · 28/12/16

Mong Anh HieuCD giúp em lọc ra những công nhân nào làm thôi ở Sheet4!C2( của Anh là nạp theo tổ).
Như gỏ tháng 10 tổ 1 thì trong validation của C2 chỉ hiện những công nhân nào của tổ 1 có làm ra sản phẩm trong tháng 10 thôi.
Làm phiền Anh quá.
Mong Anh giúp.

HieuCD · 28/12/16

NguyenthiH đã viết:
Mong Anh HieuCD giúp em lọc ra những công nhân nào làm thôi ở Sheet4!C2( của Anh là nạp theo tổ).
Như gỏ tháng 10 tổ 1 thì trong validation của C2 chỉ hiện những công nhân nào của tổ 1 có làm ra sản phẩm trong tháng 10 thôi.
Làm phiền Anh quá.
Mong Anh giúp.

bạn dùng code mới trong sheet4, tự cập nhật list của tổ và tên công nhân

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:C2")) Is Nothing Then
    If Sheets("Sheet2").Range("B65500").End(xlUp).Row <= 3 Then Exit Sub
    Dim Darr(), Toa(), CN(), Arr(), i As Long, j As Byte, thang As Byte, tocn, tencn As String, tt As Double, tmp As Boolean
    Darr = Sheets("Sheet2").Range("A4:G" & Sheets("Sheet2").Range("A65500").End(xlUp).Row).Value
    ReDim Arr(1 To UBound(Darr), 1 To 4)
    ReDim CN(1 To UBound(Darr))
    thang = Range("A2").Value: tocn = Range("B2").Value: tencn = Range("C2").Value
    'Tao danh sach TO Cong Nhan
    If Not Intersect(Target, Range("A2")) Is Nothing Then
        Set Dic = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Darr)
            If Month(Darr(i, 1)) = thang And Not Dic.Exists(Darr(i, 3)) Then Dic.Add Darr(i, 3), ""
        Next i
        Toa = Sheets("Sheet1").Range("K4:K" & Sheets("Sheet1").Range("K65500").End(xlUp).Row).Value
        For i = 1 To UBound(Toa)
            If Dic.Exists(Toa(i, 1)) Then
                k = k + 1:  CN(k) = Toa(i, 1)
                If CN(k) = tocn Then tmp = True
            End If
        Next i
        Set Dic = Nothing
        If tmp = False Then Range("B2") = ""
        If k > 0 Then
            ReDim Preserve CN(1 To k)
            Range("B2").Validation.Delete
            Range("B2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:=Join(CN, ",")
        End If
        k = 0:  tmp = False
    End If
    'Tao danh sach Ten Cong Nhan
    If Not Intersect(Target, Range("A2:B2")) Is Nothing Then
        Set Dic = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Darr)
            If Month(Darr(i, 1)) = thang And Darr(i, 3) = tocn Then
                If Not Dic.Exists(Darr(i, 2)) Then
                    Dic.Add Darr(i, 2), ""
                    k = k + 1:  CN(k) = Darr(i, 2)
                    If CN(k) = tencn Then tmp = True
                End If
            End If
        Next i
        Set Dic = Nothing
        If tmp = False Then Range("C2") = ""
        If k > 0 Then
            ReDim Preserve CN(1 To k)
            Range("C2").Validation.Delete
            Range("C2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:=Join(CN, ",")
        End If
        k = 0
    End If
    'Cap nhat Chi Tiet Cong Viec
    For i = 1 To UBound(Darr)
        If Month(Darr(i, 1)) = thang And Darr(i, 2) = tencn And Darr(i, 3) = tocn Then
            k = k + 1
            For j = 1 To 4
                Arr(k, j) = Darr(i, j + 3)
            Next j
            tt = tt + Arr(k, 4)
        End If
    Next i
    Sheets("Sheet4").Range("A5:D1000").Clear
    If k > 0 Then
        Sheets("Sheet4").Range("A5").Resize(k, 4) = Arr
        Sheets("Sheet4").Range("C5").Offset(k, 0) = Range("B1") & "ng " & Range("D4")
        Sheets("Sheet4").Range("D5").Offset(k, 0) = tt
        Sheets("Sheet4").Range("A4").Resize(k + 2, 4).Borders.LineStyle = 1
    End If
End If
Erase Darr: Erase Arr: Erase CN: Erase Toa
End Sub

NguyenthiH · 28/12/16

Cám Ơn Anh HieuCD nhiều nhiều. Thật lòng cám ơn !$@!!

NguyenthiH · 28/12/16

File mới của Anh, em bỏ mấy name TenCN và ToCN cũng chạy code, vậy em delete luôn mấy name đó được không Anh??

HieuCD · 28/12/16

NguyenthiH đã viết:
File mới của Anh, em bỏ mấy name TenCN và ToCN cũng chạy code, vậy em delete luôn mấy name đó được không Anh??

mấy name đó không dùng nữa xóa đi, riêng trong sheet1 bên phải mình có đóng khung danh sách tổ thì giử lại, khi thêm tổ mới thì nhập thêm vào. mình giử chổ đó để danh sách tổ hiện ra theo thứ tự

Gỏ Mã Công đoạn, dò theo mã hàng lấy tên công đoạn

Thành viên mới đăng ký

File đính kèm

Thành viên mới đăng ký

Chuyên gia GPE

Thành viên mới đăng ký

0901452không62

File đính kèm

Thành viên mới đăng ký

Thành viên mới đăng ký

Chuyên gia GPE

File đính kèm

0901452không62

Thành viên mới đăng ký

Chuyên gia GPE

Thành viên mới đăng ký

Thành viên mới đăng ký

Chuyên gia GPE

Thành viên mới đăng ký

Thành viên mới đăng ký

Chuyên gia GPE

File đính kèm

Thành viên mới đăng ký

Thành viên mới đăng ký

Chuyên gia GPE