Nhờ các anh chị trợ giúp lọc dữ liệu như mẫu đính kèm (1 người xem)

[toangm]

Nhờ các anh chị trợ giúp lọc dữ liệu như mẫu đính kèm. Em có khoảng 15.000 dòng dữ liệu như vậy nên cần trợ giúp từ anh chị

 

[PacificPR]

Nhờ các anh chị trợ giúp lọc dữ liệu như mẫu đính kèm. Em có khoảng 15.000 dòng dữ liệu như vậy nên cần trợ giúp từ anh chị

Bạn xem file xem sao ( Thử với hơn 15000 dòng thấy cũng được được )

 

[toangm]

Bạn xem file xem sao

Em cảm ơn nhiều! nhờ có bác công việc của em sẽ đỡ vất vả hơn.

 

[PacificPR]

Em cảm ơn nhiều! nhờ có bác công việc của em sẽ đỡ vất vả hơn.

Bạn dùng cái này dễ nhìn hơn này

Sub TachKho1()
    Dim tArr, sArr, dArr(1 To 65535, 1 To 2), i As Long, J As Long, K As Long
    Dim Dic As Object, ShName As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Dulieu")
    tArr = .Range("A1", .Range("A65535").End(3)).Resize(, 3).Value
    sArr = .Range("F2", .Range("F65535").End(3)).Resize(, 2).Value
    For J = 1 To UBound(tArr, 2)
        For i = 2 To UBound(tArr)
            If tArr(i, J) <> Empty Then
                Dic.Item(tArr(i, J)) = tArr(1, J)
            End If
        Next i
    Next J
    For J = 1 To 3
        For i = 1 To UBound(sArr)
            If .Cells(1, J) = Dic.Item(sArr(i, 1)) Then
                K = K + 1
                dArr(K, 1) = sArr(i, 1)
                dArr(K, 2) = sArr(i, 2)
            End If
        Next i
        ShName = .Cells(1, J)
        With Sheets(ShName)
            .Range("A2").Resize(15000, 2).ClearContents
            .Range("A2").Resize(K, 2) = dArr
            Erase dArr: K = 0
        End With
    Next J
End With
Set Dic = Nothing
End Sub

 

[toangm]

Anh kiểm tra giúp em Tại bảng dữ liệu nếu cột K không có UserXX thì bị báo lỗi khi chạy chương trình.

 

[PacificPR]

Anh kiểm tra giúp em Tại bảng dữ liệu nếu cột K không có UserXX thì bị báo lỗi khi chạy chương trình.

Bạn thử lại với cái này xem (Bạn này được này 0:26 mà còn làm việc . Giờ đó em đang rồi ... )

Option Explicit
Sub TachKho()
    Dim tArr, sArr, dArr(1 To 65535, 1 To 11), i As Long, J As Long, Col As Long, K As Long
    Dim Dic As Object, ShName As String, Header As Range
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Call DelSheet
With Sheets("DuLieu")
    Set Header = .Range("K1:U1")
    tArr = .Range("A1", .Range("A65535").End(3)).Resize(, 9).Value
    sArr = .Range("K2", .Range("K65535").End(3)).Resize(, 11).Value
    For J = 1 To UBound(tArr, 2)
        For i = 2 To UBound(tArr)
            If tArr(i, J) <> Empty Then
                Dic.Item(tArr(i, J)) = tArr(1, J)
            End If
        Next i
    Next J
    For J = 1 To UBound(tArr, 2)
        For i = 1 To UBound(sArr)
            If tArr(1, J) = Dic.Item(sArr(i, 1)) Then
                K = K + 1
                For Col = 1 To 11
                    dArr(K, Col) = sArr(i, Col)
                Next Col
            End If
        Next i
        If K Then
            ShName = tArr(1, J)
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = ShName
            With Sheets(ShName)             
                Header.Copy
                .Range("A1").PasteSpecial xlPasteColumnWidths
                .Range("A1").PasteSpecial xlPasteValues
                .Range("A1").PasteSpecial xlPasteFormats
                .Range("A2").Resize(K, UBound(sArr, 2)) = dArr
                Erase dArr: K = 0
            End With
        End If
    Next J
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
Set Dic = Nothing
End Sub
Sub DelSheet()
    ' Xoa Sheets("Khoxx")
    Dim ws As Worksheet
    For Each ws In Worksheets
        If ws.Name <> "DuLieu" Then
            ws.Delete
        End If
    Next
End Sub

 

[toangm]

Bạn thử lại với cái này xem

1. Anh giúp em phần đánh số thứ tự tại các bảng dữ liệu đã lọc với!
2. Cột nào có mã hàng bắt đầu từ số 0 thì khi lọc dữ liệu nó bị mất số 0 ở đầu (mặc định, định dạng là Number nên bị vậy).
3. Nếu được anh giúp em phần tổng cộng phần số lượng ở cuối cùng.
Thông cảm vì em gà mờ món này quá, ngồi mày mò mãi không ra nên nhờ các anh giúp đỡ,.

 

[PacificPR]

1. Anh giúp em phần đánh số thứ tự tại các bảng dữ liệu đã lọc với!
2. Cột nào có mã hàng bắt đầu từ số 0 thì khi lọc dữ liệu nó bị mất số 0 ở đầu (mặc định, định dạng là Number nên bị vậy).
3. Nếu được anh giúp em phần tổng cộng phần số lượng ở cuối cùng.
Thông cảm vì em gà mờ món này quá, ngồi mày mò mãi không ra nên nhờ các anh giúp đỡ,.

Bạn kiểm tra file thử

 

[toangm]

Bạn kiểm tra file thử

Kiến thức là biển cả may mà em vớ được cọc là anh. Cảm ơn anh nhiều nhiều, nhờ anh em vỡ ra được nhiều việc ..... Một lần nữa xin cảm ơn anh đã giúp đỡ