Nhờ chỉ cách lọc dữ liệu từ excel và xuất ra nhiều file excel con khác

Chia sẻ bởi:hands

★★★★★

‹ Nhờ viết giùm VBA cho file dữ... Tách chuỗi khi độ dài ký tự... ›

Quảng cáo

Nhờ mọi người giúp mình lọc từng BRANCH ra các file riêng với mỗi BRANCH ứng với tên "BANGTHONGBAO_IDBRANCH_TenBRANCH". Dưới là file mẫu của mình với ít dữ liệu demo, vì dữ liệu thật hơn ngàn dòng.

Mình đã nghĩ theo phương pháp lọc sau đó copy paste vào từng file riêng rồi, nhưng mình muốn một giải pháp khác là sau khi chạy sẽ từ sinh ra các file tương ứng với tên từng file đã định trước. Rất mong mọi người giúp đỡ và cho giải pháp. Xin cảm ơn.

Bạn làm theo code của ai? Lỗi gì có trời mới biết…

Thích thì chạy code này xem…

Option Explicit

Public Sub GPE()
Dim Dic As Object, Tmp As String, Arr, Pth, ShMain As Worksheet
Dim I As Long, WbMain As Workbook, Rng As Range, Sh As Worksheet, Stt As Range, K As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.SheetsInNewWorkbook = 1
Set WbMain = ThisWorkbook
Set ShMain = WbMain.Sheets("BANGTHONGTIN")
Set Rng = ShMain.Range("A1").CurrentRegion
Pth = ActiveWorkbook.Path
Arr = Rng.Value
Set Dic = CreateObject("Scripting.Dictionary")
With Dic
For I = 2 To UBound(Arr)
Tmp = Arr(I, 2)
    If Not .Exists(Tmp) Then
        .Add Tmp, ""
        With Workbooks.Add
            Set Sh = .Sheets(1)
            Sh.Name = ShMain.Name
            Rng.AutoFilter 2, Tmp
            ShMain.Range("A1", Rng).SpecialCells(12).Copy
            Sh.Range("A1").PasteSpecial xlPasteColumnWidths
            Sh.Range("A1").PasteSpecial xlPasteAll
            Rng.AutoFilter
            Set Stt = Sh.Range("A2", Sh.Range("A65000").End(3))
                K = Stt.Rows.Count
                Stt = Application.Evaluate("Row(1:" & K & ")")
                Sh.Range("A1").CurrentRegion.Borders.LineStyle = 1
                .Close True, Pth & "BANGTHONGBAO_" & Arr(I, 8) & "_" & Tmp & ".xlsx"
        End With
    End If
Next I
End With
Set Dic = Nothing
ShMain.AutoFilterMode = False
Application.CutCopyMode = False
Application.SheetsInNewWorkbook = 3
MsgBox "Da Tach Xong!"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Code của bác quá tuyệt vời bác ạ, hầu như đáp ứng hết yêu cầu của mình, tuy nhiên vẫn bị lỗi kia nên xuất thiếu 10 file, mình tìm hiểu nó bị ngặt khúc nào thì thấy đến cái đoạn tên "BRANCH" có dạng dấu / là bị lỗi.

VD: TT_VAB/CBA

Mình đổi tên xóa dấu / ở đoạn này thì nó chạy trơn tru đến cuối luôn. Cảm ơn bác rất nhiều. }}}}}

Có 9 ký tự đặc biệt không được dùng để đặt tên cho tập tin. Bạn tham khảo mà tránh.


 /
 :
 *
 ?
 "
 <
 >
 |

Do file xuất từ database ra bác ạ. Tks bác

Ờ thì bấy lâu nay bạn tưởng rằng anh Bill cho bạn xài dấu / khi đặt Tên tệp tin cơ ah???–=0–=0–=0

Khuyến mại thêm cho bạn đoạn code ngắn gọn hơn code trên/chắc chạy nhanh hơn code cũ 1 xíu…và có lẽ là giữ lại đúng Format của Sheet gốc của bạn luôn…

Public Sub GPE_Copy()
Dim Dic As Object, Tmp As String, Arr, Pth, ShMain As Worksheet, I As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ShMain = ThisWorkbook.Sheets("BANGTHONGTIN")
Pth = ThisWorkbook.Path
Arr = ShMain.Range("A1").CurrentRegion.Value
Set Dic = CreateObject("Scripting.Dictionary")
For I = 2 To UBound(Arr)
Tmp = Arr(I, 2)
    If Not Dic.Exists(Tmp) Then
        Dic.Add Tmp, ""
        ShMain.Copy
        With ActiveWorkbook.Sheets(1)
            .Range("A1").CurrentRegion.AutoFilter 2, "<>" & Tmp
            .Range("A1").CurrentRegion.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
            .Range("A1").Value = "NO."
            .Range("A1").CurrentRegion.Borders.LineStyle = 1
            .Range("A2", .Range("A65000").End(3)) = Application.Evaluate("Row(1:" & .Range("A65000").End(3).Row - 1 & ")")
        End With
            ActiveWorkbook.Close True, Pth & "BANGTHONGBAO_" & Arr(I, 8) & "_" & Tmp & ".xlsx"
    End If
Next I
Set Dic = Nothing
Application.CutCopyMode = False
MsgBox "Da Tach Xong!"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

www.giaiphapexcel.com/diendan/threads/nh%E1%BB%9D-ch%E1%BB%89-c%C3%A1ch-l%E1%BB%8Dc-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-excel-v%C3%A0-xu%E1%BA%A5t-ra-nhi%E1%BB%81u-file-excel-con-kh%C3%A1c.117244/