Nhờ giúp đỡ thêm và sửa code lọc dữ liệu

Thanh1102 · 30/1/21

Mình có file cần lọc và lấy dữ liệu nhưng không xử lý được. Xin nhờ các anh/chị và các bạn trợ giúp
1- Chuyển dữ liệu từ công thức sang VBA (Sheet "Plan" từ cột A đến cột T)
2- Sửa code VBA trong module
Trân trọng cảm ơn.

BuiQuangThuan · 30/1/21

Thanh1102 đã viết:
Mình có file cần lọc và lấy dữ liệu nhưng không xử lý được. Xin nhờ các anh/chị và các bạn trợ giúp
1- Chuyển dữ liệu từ công thức sang VBA (Sheet "Plan" từ cột A đến cột T)
2- Sửa code VBA trong module
Trân trọng cảm ơn.

Em chẳng biết sửa cái gì luôn á. anh nói thế thì người giúp biết giúp cái gì

Maika8008 · 31/1/21

Thanh1102 đã viết:
Mình có file cần lọc và lấy dữ liệu nhưng không xử lý được. Xin nhờ các anh/chị và các bạn trợ giúp
1- Chuyển dữ liệu từ công thức sang VBA (Sheet "Plan" từ cột A đến cột T)
2- Sửa code VBA trong module
Trân trọng cảm ơn.

Làm cho yêu cầu 2, bạn xem thử kết quả thế nào chứ tôi không tìm hiểu ý nghĩa của kết quả này

Rich (BB code):

Public Sub sGpe()
Dim Dic As Object, sArr(), dArr(), tArr(), CoL(), Tmp, Txt As String, Tem As String
Dim C As Long, I As Long, J As Long, K As Long, N As Long, R As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("ZKHO")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, 27).Value
    R = UBound(sArr)
    ReDim tArr(1 To R, 1 To 2)
End With
    For I = 1 To R
        Txt = sArr(I, 1) & "#" & sArr(I, 14)
        If Not Dic.Exists(Txt) Then
            K = K + 1
            Dic.Item(Txt) = K
            tArr(K, 1) = sArr(I, 16)
            tArr(K, 2) = sArr(I, 17)
        Else
            Rws = Dic.Item(Txt)
            tArr(Rws, 1) = tArr(Rws, 1) + sArr(I, 16)
            tArr(Rws, 2) = tArr(Rws, 2) + sArr(I, 17)
        End If
    Next I
    '----------------------------------------------------
    K = 0
With Sheets("Plan")
    sArr = .Range("C7", .Range("C7").End(xlDown)).Value
    CoL = .Range("U3", .Range("U3").End(xlToRight)).Value
    R = UBound(sArr)
    C = UBound(CoL, 2)
    ReDim dArr(1 To R, 1 To C)
    For I = 1 To R
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            dArr(K, 3) = Tem
        End If
    Next
    For I = 1 To R
        For J = 1 To C
            Txt = sArr(I, 1) & "#" & CoL(1, J)
            If Dic.Exists(Txt) Then
                Rws = Dic.Item(Txt)
                If (tArr(Rws, 1) / 48) = 0 And tArr(Rws, 2) > 0 Then
                    dArr(I, J) = "Thieu"
                Else
                    dArr(I, J) = tArr(Rws, 1) / 48
                End If
            End If
        Next J
        '--------------------------------------
        For J = 10 To 12
            Txt = sArr(I, 1) & "#" & CoL(1, J)
            If Dic.Exists(Txt) Then
                Rws = Dic.Item(Txt)
                If (tArr(Rws, 1) / 12) = 0 And tArr(Rws, 2) > 0 Then
                    dArr(I, J) = "Thieu"
                Else
                    dArr(I, J) = tArr(Rws, 1) / 12
                End If
            End If
        Next J
    Next I
    .Range("U7").Resize(R, C) = dArr
End With
End Sub

Maika8008 · 31/1/21

Kèm file có cả 2 yêu cầu

Ba Tê · 1/2/21

Thanh1102 đã viết:
Mình có file cần lọc và lấy dữ liệu nhưng không xử lý được. Xin nhờ các anh/chị và các bạn trợ giúp
1- Chuyển dữ liệu từ công thức sang VBA (Sheet "Plan" từ cột A đến cột T)
2- Sửa code VBA trong module
Trân trọng cảm ơn.

Nhìn cách viết code thấy "quen quen", nhưng không hiểu yêu cầu là gì.

Thanh1102 · 1/2/21

Cảm ơn anh @Ba Tê , @Maika8008 , @buiquangthuan đã xem và hỗ trợ.
Mục đích của bài này là:
1- Lọc và lấy dữ liệu số SO duy nhất cùng với các thông tin đi kèm (ID, Customer...sheet "ZKHO" sang cột A đến T trong sheet "Plan"
2- Do 1 SO có nhiều mã hàng, loại hàng và số lượng khác nhau nên:
lấy dữ liệu từ sheet "ZKHO" theo mã hàng (Cột N) ứng với các mã hàng từ U3-BI3 bên sheet "Plan". Số lượng (Cột Z) từ sheet "ZKHO" sẽ tương ứng với các mã hàng và SO tương ứng.

Ghi chú: Code của @Maika8008 đã chạy tuy nhiên có 1 mã hàng bị lấy sai (Cột W) bên sheet "Plan"

Maika8008 · 1/2/21

Thanh1102 đã viết:
Cảm ơn anh @Ba Tê , @Maika8008 , @buiquangthuan đã xem và hỗ trợ.

Ghi chú: Code của @Maika8008 đã chạy tuy nhiên có 1 mã hàng bị lấy sai (Cột W) bên sheet "Plan"

Ấy, kết quả ghi ra từ cột U trở đi là tôi sửa sub GPE của bạn (yêu cầu 2) có sẵn tại 2 chỗ:
- Code đó thiếu dòng next của 1 vòng lặp
- và không có With Dic nhưng bên dưới lại là .Exists(Tem).

Còn ngoài ra tôi không làm thêm gì cả.

Thanh1102 · 1/2/21

Maika8008 đã viết:
Ấy, kết quả ghi ra từ cột U trở đi là tôi sửa sub GPE của bạn (yêu cầu 2) có sẵn tại 2 chỗ:
- Code đó thiếu dòng next của 1 vòng lặp
- và không có With Dic nhưng bên dưới lại là .Exists(Tem).

Còn ngoài ra tôi không làm thêm gì cả.

Xin lỗi bạn. Mình cũng đang chưa biết nguyên nhân ờ đâu mà cột đó bị lỗi vậy (Bị sai tại các SO không có mã hàng đó. Bạn xem giúp mình nhé.

Maika8008 · 1/2/21

Thanh1102 đã viết:
Xin lỗi bạn. Mình cũng đang chưa biết nguyên nhân ờ đâu mà cột đó bị lỗi vậy (Bị sai tại các SO không có mã hàng đó. Bạn xem giúp mình nhé.

Tìm ra chỗ sai rồi, bạn soát sét lại kết quả thử:

Rich (BB code):

Public Sub sGpe()
Dim Dic As Object, sArr(), dArr(), tArr(), CoL(), Tmp, Txt As String, Tem As String
Dim C As Long, i As Long, j As Long, K As Long, N As Long, R As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("ZKHO")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, 27).Value
    R = UBound(sArr)
    ReDim tArr(1 To R, 1 To 2)
End With
    For i = 1 To R
        Txt = sArr(i, 1) & "#" & sArr(i, 14)
        If Not Dic.Exists(Txt) Then
            K = K + 1
            Dic.Item(Txt) = K
            tArr(K, 1) = sArr(i, 16)
            tArr(K, 2) = sArr(i, 17)
        Else
            Rws = Dic.Item(Txt)
            tArr(Rws, 1) = tArr(Rws, 1) + sArr(i, 16)
            tArr(Rws, 2) = tArr(Rws, 2) + sArr(i, 17)
        End If
    Next i
    '----------------------------------------------------
    K = 0
With Sheets("Plan")
    sArr = .Range("C7", .Range("C7").End(xlDown)).Value
    CoL = .Range("U3", .Range("U3").End(xlToRight)).Value
    R = UBound(sArr)
    C = UBound(CoL, 2)
    ReDim dArr(1 To R, 1 To C)
    For i = 1 To R
        Tem = sArr(i, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            dArr(K, 3) = Tem
        End If
    Next
    For i = 1 To R
        For j = 1 To C
            If j <> 3 Then  'Them dong nay
                Txt = sArr(i, 1) & "#" & CoL(1, j)
                If Dic.Exists(Txt) Then
                    Rws = Dic.Item(Txt)
                    If (tArr(Rws, 1) / 48) = 0 And tArr(Rws, 2) > 0 Then
                        dArr(i, j) = "Thieu"
                    Else
                        dArr(i, j) = tArr(Rws, 1) / 48
                    End If
                End If
            End If  'Them dong nay
        Next j
        '--------------------------------------
        For j = 10 To 12
            Txt = sArr(i, 1) & "#" & CoL(1, j)
            If Dic.Exists(Txt) Then
                Rws = Dic.Item(Txt)
                If (tArr(Rws, 1) / 12) = 0 And tArr(Rws, 2) > 0 Then
                    dArr(i, j) = "Thieu"
                Else
                    dArr(i, j) = tArr(Rws, 1) / 12
                End If
            End If
        Next j
    Next i
    .Range("U7").Resize(R, C) = dArr
End With
End Sub

Thanh1102 · 1/2/21

Maika8008 đã viết:

Tìm ra chỗ sai rồi, bạn soát sét lại kết quả thử:

Rich (BB code):

Public Sub sGpe()
Dim Dic As Object, sArr(), dArr(), tArr(), CoL(), Tmp, Txt As String, Tem As String
Dim C As Long, i As Long, j As Long, K As Long, N As Long, R As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("ZKHO")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, 27).Value
    R = UBound(sArr)
    ReDim tArr(1 To R, 1 To 2)
End With
    For i = 1 To R
        Txt = sArr(i, 1) & "#" & sArr(i, 14)
        If Not Dic.Exists(Txt) Then
            K = K + 1
            Dic.Item(Txt) = K
            tArr(K, 1) = sArr(i, 16)
            tArr(K, 2) = sArr(i, 17)
        Else
            Rws = Dic.Item(Txt)
            tArr(Rws, 1) = tArr(Rws, 1) + sArr(i, 16)
            tArr(Rws, 2) = tArr(Rws, 2) + sArr(i, 17)
        End If
    Next i
    '----------------------------------------------------
    K = 0
With Sheets("Plan")
    sArr = .Range("C7", .Range("C7").End(xlDown)).Value
    CoL = .Range("U3", .Range("U3").End(xlToRight)).Value
    R = UBound(sArr)
    C = UBound(CoL, 2)
    ReDim dArr(1 To R, 1 To C)
    For i = 1 To R
        Tem = sArr(i, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            dArr(K, 3) = Tem
        End If
    Next
    For i = 1 To R
        For j = 1 To C
            If j <> 3 Then  'Them dong nay
                Txt = sArr(i, 1) & "#" & CoL(1, j)
                If Dic.Exists(Txt) Then
                    Rws = Dic.Item(Txt)
                    If (tArr(Rws, 1) / 48) = 0 And tArr(Rws, 2) > 0 Then
                        dArr(i, j) = "Thieu"
                    Else
                        dArr(i, j) = tArr(Rws, 1) / 48
                    End If
                End If
            End If  'Them dong nay
        Next j
        '--------------------------------------
        For j = 10 To 12
            Txt = sArr(i, 1) & "#" & CoL(1, j)
            If Dic.Exists(Txt) Then
                Rws = Dic.Item(Txt)
                If (tArr(Rws, 1) / 12) = 0 And tArr(Rws, 2) > 0 Then
                    dArr(i, j) = "Thieu"
                Else
                    dArr(i, j) = tArr(Rws, 1) / 12
                End If
            End If
        Next j
    Next i
    .Range("U7").Resize(R, C) = dArr
End With
End Sub

Cảm ơn @Maika8008 . Vẫn bị cột đó bạn à. Nó lấy đúng số SO điền vào cột đó. Và trong sheet"Plan" thì nó đang là cột 14 luôn (Tính từ cột SO)

Ba Tê · 1/2/21

Thanh1102 đã viết:
Cảm ơn @Maika8008 . Vẫn bị cột đó bạn à. Nó lấy đúng số SO điền vào cột đó. Và trong sheet"Plan" thì nó đang là cột 14 luôn (Tính từ cột SO)

Bạn xem và kiểm tra file này xem sao.
Cột C và dòng 3 sheet "Plan" là do bạn nhập thủ công nhé.

Maika8008 · 1/2/21

Thanh1102 đã viết:
Cảm ơn @Maika8008 . Vẫn bị cột đó bạn à. Nó lấy đúng số SO điền vào cột đó. Và trong sheet"Plan" thì nó đang là cột 14 luôn (Tính từ cột SO)

Bạn diễn đạt 1 lần nghe cho nó rõ ràng cái nào!

Ở bài #2 tôi có nói :"tôi không tìm hiểu ý nghĩa của kết quả này". Thực tế là ai đó đã viết code cho bạn đựa vào mong muốn của bạn.

Tôi chỉ phỏng đoán ý đồ của bạn dựa vào các dòng code có sẵn chứ tôi đâu biết bạn muốn gì?

Và ngay ở trong chủ đề này, nhiều người cũng đã phê bạn ở chỗ không biết bạn muốn giúp gì, bạn có thấy không?

Thanh1102 · 1/2/21

Maika8008 đã viết:
Bạn diễn đạt 1 lần nghe cho nó rõ ràng cái nào!

Ở bài #2 tôi có nói :"tôi không tìm hiểu ý nghĩa của kết quả này". Thực tế là ai đó đã viết code cho bạn đựa vào mong muốn của bạn.

Tôi chỉ phỏng đoán ý đồ của bạn dựa vào các dòng code có sẵn chứ tôi đâu biết bạn muốn gì?

Và ngay ở trong chủ đề này, nhiều người cũng đã phê bạn ở chỗ không biết bạn muốn giúp gì, bạn có thấy không?

Cảm ơn @Maika8008 nhiều. Cảm ơn @Ba Tê đã xử lý giúp đúng dữ liệu rồi ạ.

Nhờ giúp đỡ thêm và sửa code lọc dữ liệu

Thanh1102

Thành viên hoạt động

File đính kèm

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

Maika8008

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

Maika8008

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

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

Thanh1102

Thành viên hoạt động

Maika8008

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

Thanh1102

Thành viên hoạt động

Maika8008

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

Thanh1102

Thành viên hoạt động

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

Maika8008

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

Thanh1102

Thành viên hoạt động

Bài viết mới nhất

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