Lỗi lọc trùng dữ liệu nhiều sheet không chính xác

[Thanh Bình PV]

Lúc trước bác Snow đã biết cho e 1 code lọc trùng dữ liệu từ nhiều sheet ( Name sheet bắt đầu là "ASEMBLY") nhưng hiện tại thì e áp dụng thì bị sai. kết quả không chính xác. Nhờ A/Chị GPE giúp e sửa lại code với ạ. (số lượng sheet lọc tầm 100 sheet). Nếu được thêm điều kiện nếu cột J có TO SITE thì sẽ copy qua sheet "MR-S" ạ.
Em cảm ơn.

Sub Extract_Click()
     Dim sh As Worksheet
     Dim n, g, u, ld As Long
     Dim dia As Object, kq3(1 To 1000, 1 To 9)
     Dim acc, dk3 As String
     Set dia = CreateObject("scripting.dictionary")
     For Each sh In ThisWorkbook.Worksheets
        If InStr(1, sh.Name, "ASSEMBLY") Then
            acc = sh.Range("B41:J500").Value
            For n = 1 To UBound(acc)
                If acc(n, 1) <> Empty Then
                   dk3 = UCase(acc(n, 2)) & "#" & UCase(acc(n, 6)) & "#" & UCase(acc(n, 9))
                   If Not dia.exists(dk3) Then
                      g = g + 1
                      dia.Add dk3, g
                      kq3(g, 1) = acc(n, 2)
                      kq3(g, 5) = acc(n, 6)
                      kq3(g, 9) = acc(n, 9)
                   End If
                      u = dia.Item(dk3)
                      kq3(g, 4) = kq3(g, 4) + acc(n, 5)
                End If
            Next n
       End If
   Next
   With Sheets("MR - F")
        ld = .Range("B" & Rows.Count).End(xlUp).Row
        If ld > 29 Then .Range("B30:J" & ld).ClearContents
        If g Then .Range("B30:J30").Resize(g).Value = kq3
   End With
   Application.CutCopyMode = False
End Sub

 

[Thanh Bình PV]

Bác nào giúp e với ạ.

Bài đã được tự động gộp: 18/12/19

Lúc trước bác Snow đã biết cho e 1 code lọc trùng dữ liệu từ nhiều sheet ( Name sheet bắt đầu là "ASEMBLY") nhưng hiện tại thì e áp dụng thì bị sai. kết quả không chính xác. Nhờ A/Chị GPE giúp e sửa lại code với ạ. (số lượng sheet lọc tầm 100 sheet). Nếu được thêm điều kiện nếu cột J có TO SITE thì sẽ copy qua sheet "MR-S" ạ.
Em cảm ơn.

Sub Extract_Click()
     Dim sh As Worksheet
     Dim n, g, u, ld As Long
     Dim dia As Object, kq3(1 To 1000, 1 To 9)
     Dim acc, dk3 As String
     Set dia = CreateObject("scripting.dictionary")
     For Each sh In ThisWorkbook.Worksheets
        If InStr(1, sh.Name, "ASSEMBLY") Then
            acc = sh.Range("B41:J500").Value
            For n = 1 To UBound(acc)
                If acc(n, 1) <> Empty Then
                   dk3 = UCase(acc(n, 2)) & "#" & UCase(acc(n, 6)) & "#" & UCase(acc(n, 9))
                   If Not dia.exists(dk3) Then
                      g = g + 1
                      dia.Add dk3, g
                      kq3(g, 1) = acc(n, 2)
                      kq3(g, 5) = acc(n, 6)
                      kq3(g, 9) = acc(n, 9)
                   End If
                      u = dia.Item(dk3)
                      kq3(g, 4) = kq3(g, 4) + acc(n, 5)
                End If
            Next n
       End If
   Next
   With Sheets("MR - F")
        ld = .Range("B" & Rows.Count).End(xlUp).Row
        If ld > 29 Then .Range("B30:J" & ld).ClearContents
        If g Then .Range("B30:J30").Resize(g).Value = kq3
   End With
   Application.CutCopyMode = False
End Sub

Em đã biết nguyên nhân ạ. Bác nào giúp e thêm điều kiện với ạ