Lọc sản phẩm ở nhiều sheet và lưu thành file riêng

camlam06 · 15/10/17

Em xin chào cách anh/chị, em có một vấn đề với việc lọc, tách, lưu file, và em có tìm kiếm trên diễn đàn, có một số chủ đề đã bàn luận gần giống với vấn đề của em, nhưng do bài đã cách mấy năm. Nên em xin phép đăng mới ở đây, nếu không phải, xin nhờ ad chuyển giùm vào chủ đề đúng giúp em.
Em có một file gồm 3 sheet (file thực tế nhiều hơn) là Xuất, Nhập, Tồn. Ở mỗi sheet sẽ có 3 sản phẩm (thực tế nhiều hơn). Em cần lọc theo từng sản phẩm một ở cả 3 sheet, nghĩa là mỗi file chỉ để 1 sản phẩm, các sản phẩm còn lại sẽ bị xóa đi, sau đó lưu thành file riêng có tên file, sản phẩm được giử lại tương ứng. "File Gốc" không bị thay đổi. Có bao nhiêu sản phẩm tách ra bấy nhiêu file. Chi tiết em trình bày rõ trong sheet "Yêu cầu" của file "File Gốc"
Mong các anh/chị trong diễn đàn hướng dẫn giúp em, đặc biệt là các anh/chị lão làng như anh ndu96081631, BNTT......... Em cảm ơn !

camlam06 · 20/10/17

Các anh/chị cố gắng giúp em. Thanks !

Hai Lúa Miền Tây · 20/10/17

camlam06 đã viết:
Em xin chào cách anh/chị, em có một vấn đề với việc lọc, tách, lưu file, và em có tìm kiếm trên diễn đàn, có một số chủ đề đã bàn luận gần giống với vấn đề của em, nhưng do bài đã cách mấy năm. Nên em xin phép đăng mới ở đây, nếu không phải, xin nhờ ad chuyển giùm vào chủ đề đúng giúp em.
Em có một file gồm 3 sheet (file thực tế nhiều hơn) là Xuất, Nhập, Tồn. Ở mỗi sheet sẽ có 3 sản phẩm (thực tế nhiều hơn). Em cần lọc theo từng sản phẩm một ở cả 3 sheet, nghĩa là mỗi file chỉ để 1 sản phẩm, các sản phẩm còn lại sẽ bị xóa đi, sau đó lưu thành file riêng có tên file, sản phẩm được giử lại tương ứng. "File Gốc" không bị thay đổi. Có bao nhiêu sản phẩm tách ra bấy nhiêu file. Chi tiết em trình bày rõ trong sheet "Yêu cầu" của file "File Gốc"
Mong các anh/chị trong diễn đàn hướng dẫn giúp em, đặc biệt là các anh/chị lão làng như anh ndu96081631, BNTT......... Em cảm ơn !

Sao phải tách file ra như vậy bạn?

VetMini · 20/10/17

camlam06 đã viết:
Các anh/chị cố gắng giúp em. Thanks !

Cố gắng thì được nhưng tôi sợ bị tê hát a anh ca ếch lắm.

camlam06 · 22/10/17

Dạ, vì mỗi cơ sở bên em bán một loại sản phẩm đặc thù, file của em thì em phải theo dõi cả, nhưng cuối ngày thì em phải tách ra để gửi cho từng cơ sở một, điều kiện là cơ sở này không được thấy sản phẩm của cơ sở kia, nên phải tách vậy. Vì là ví dụ mẫu nên em làm đơn giản vậy để mọi người hiểu file, chứ thực tế còn dính dáng nhiều cái, nên không thể nhập riêng file để khỏi phải tách, kiểu như việc tách là bắt buộc, không còn cách nào khác, giờ vấn đề là tách như thế nào thôi ạ
Em đã lập code như sau nhưng không giải quyết được vì khi vba đang ở file này thì không nhảy sang file kia được==>code này em làm quá tệ.

Mã:

Sub XoaSP()
    ActiveWorkbook.Save
    Dim i As Range, rng As Range, wbPath2 As String
    wbPath1 = ActiveWorkbook.FullName
    wbName1 = ActiveWorkbook.Name
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = False
    End With
    Sheets("Ton").Select
    r = [match(2,1/(A3:A200<>""))]
    Set rng = Range("A3:A" & r + 3)
            Sheets("Xuat").AutoFilterMode = False
            Sheets("Nhap").AutoFilterMode = False
            Sheets("Ton").AutoFilterMode = False
    For Each i In rng
        If i.EntireRow.Hidden = False Then
            Sheets("Xuat").Range("A2:C2").AutoFilter Field:=1, Criteria1:="<>*" & i & "*"
            Sheets("Ton").Range("A2:C2").AutoFilter Field:=1, Criteria1:="<>*" & i & "*"
            Sheets("Nhap").Range("A2:C2").AutoFilter Field:=1, Criteria1:="<>*" & i & "*"
            Sheets("Xuat").Select
                LastRow = Range("A3").End(xlDown).Row
                Range("A3:A" & LastRow).Delete
                ActiveSheet.ShowAllData
            Sheets("Ton").Select
                LastRow = Range("A3").End(xlDown).Row
                Range("A3:A" & LastRow).Delete
                ActiveSheet.ShowAllData
            Sheets("Nhap").Select
                LastRow = Range("A3").End(xlDown).Row
                Range("A3:A" & LastRow).Delete
                ActiveSheet.ShowAllData
            Sheets("Nhap").Select
        wbName2 = i & "-" & Format(Date, "ddmmyy") & ".xls"
        wbPath2 = ActiveWorkbook.Path & "\LocSP-" & Format(Date, "ddmmyy")
        If Len(Dir(wbPath2, vbDirectory)) = 0 Then
            MkDir wbPath2
        End If
        ActiveWorkbook.SaveAs Filename:=wbPath2 & "\" & wbName2
        Workbooks.Open Filename:=wbPath1, ReadOnly:=False
        wbName1.Active
        Application.Run ("'" & wbName1 & "'!XoaSP")
        Workbooks("wbName2").Close SaveChanges:=True
        If i = "" Then Exit Sub
        End If
    Next
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = False
    End With
End Sub

HieuCD · 22/10/17

camlam06 đã viết:
Dạ, vì mỗi cơ sở bên em bán một loại sản phẩm đặc thù, file của em thì em phải theo dõi cả, nhưng cuối ngày thì em phải tách ra để gửi cho từng cơ sở một, điều kiện là cơ sở này không được thấy sản phẩm của cơ sở kia, nên phải tách vậy. Vì là ví dụ mẫu nên em làm đơn giản vậy để mọi người hiểu file, chứ thực tế còn dính dáng nhiều cái, nên không thể nhập riêng file để khỏi phải tách, kiểu như việc tách là bắt buộc, không còn cách nào khác, giờ vấn đề là tách như thế nào thôi ạ

Ca nầy quá khó xử, chỉ có các lão làng ... mới dám nhúng tay vô, bạn la làng thêm vài lần xem sao %$$

nếu không được thì chỉnh lại bài #1 nhờ giới bình dân giúp

camlam06 · 22/10/17

HieuCD đã viết:
Ca nầy quá khó xử, chỉ có các lão làng ... mới dám nhúng tay vô, bạn la làng thêm vài lần xem sao nếu không được thì chỉnh lại bài #1 nhờ giới bình dân giúp

em có đưa đoạn code em tự viết lên #5, code này hơi dài vì em cũng gà mờ, nhưng cơ bản cũng làm được 60% rồi

be_09 · 23/10/17

camlam06 đã viết:
Em xin chào cách anh/chị, em có một vấn đề với việc lọc, tách, lưu file, và em có tìm kiếm trên diễn đàn, có một số chủ đề đã bàn luận gần giống với vấn đề của em, nhưng do bài đã cách mấy năm. Nên em xin phép đăng mới ở đây, nếu không phải, xin nhờ ad chuyển giùm vào chủ đề đúng giúp em.
Em có một file gồm 3 sheet (file thực tế nhiều hơn) là Xuất, Nhập, Tồn. Ở mỗi sheet sẽ có 3 sản phẩm (thực tế nhiều hơn). Em cần lọc theo từng sản phẩm một ở cả 3 sheet, nghĩa là mỗi file chỉ để 1 sản phẩm, các sản phẩm còn lại sẽ bị xóa đi, sau đó lưu thành file riêng có tên file, sản phẩm được giử lại tương ứng. "File Gốc" không bị thay đổi. Có bao nhiêu sản phẩm tách ra bấy nhiêu file. Chi tiết em trình bày rõ trong sheet "Yêu cầu" của file "File Gốc"
Mong các anh/chị trong diễn đàn hướng dẫn giúp em, đặc biệt là các anh/chị lão làng như anh ndu96081631, BNTT......... Em cảm ơn !

Nếu chỉ có 3 sản phẩm, thì tôi làm vầy:
1/ Thiết kế các sheet Nhap, Xuat, Ton cho tiêu đề giống nhau rồi gộp sheet.
2/ Thêm 1 sheet Gộp sau đó dùng cột A của sheet Gộp tách ra từng sản phẩm, là SP1, SP2, SP3 để lọc rồi xuất File.
Chẳng biết diễn đàn lúc này như thế nào mà vào nút Sửa rồi vào nút Thêm tùy chọn để tải File thì bị lỗi (nên không đưa File mẫu lên được).
Nó hiện thông báo như thế này:
Trang này hiện không hoạt động.

Hai Lúa Miền Tây · 23/10/17

camlam06 đã viết:
Em xin chào cách anh/chị, em có một vấn đề với việc lọc, tách, lưu file, và em có tìm kiếm trên diễn đàn, có một số chủ đề đã bàn luận gần giống với vấn đề của em, nhưng do bài đã cách mấy năm. Nên em xin phép đăng mới ở đây, nếu không phải, xin nhờ ad chuyển giùm vào chủ đề đúng giúp em.
Em có một file gồm 3 sheet (file thực tế nhiều hơn) là Xuất, Nhập, Tồn. Ở mỗi sheet sẽ có 3 sản phẩm (thực tế nhiều hơn). Em cần lọc theo từng sản phẩm một ở cả 3 sheet, nghĩa là mỗi file chỉ để 1 sản phẩm, các sản phẩm còn lại sẽ bị xóa đi, sau đó lưu thành file riêng có tên file, sản phẩm được giử lại tương ứng. "File Gốc" không bị thay đổi. Có bao nhiêu sản phẩm tách ra bấy nhiêu file. Chi tiết em trình bày rõ trong sheet "Yêu cầu" của file "File Gốc"
Mong các anh/chị trong diễn đàn hướng dẫn giúp em, đặc biệt là các anh/chị lão làng như anh ndu96081631, BNTT......... Em cảm ơn !

Bạn tạo 1 file gọi là Temp, sau đó dùng code sau để copy file Temp đó tương ứng với mỗi sản phẩm, rồi cũng đồng thời đưa dữ liệu vào tương ứng.

PHP:

Sub LocDL_HLMT()
    Dim cn, rst, fso As Object
    Dim strSP, strFile As String
    Dim rstNum, i, iCl As Integer
    Dim tblName
    Dim arrSp As Variant
      
    Set cn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    Set fso = CreateObject("Scripting.FileSystemObject")
    tblName = Array("Xuat$", "Nhap$", "Ton$")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"";")
    rst.Open ("Select F1 from [Xuat$A3:A] where F1 Is Not Null union Select F1 from [Nhap$A3:A] where F1 Is Not Null union Select F1 from [Ton$A3:A] where F1 Is Not Null"), cn, 1
    arrSp = rst.GetRows()
    rstNum = rst.RecordCount - 1
    For i = 0 To rstNum
        strSP = arrSp(0, i)
        strFile = ThisWorkbook.Path & "\" & strSP & ".xlsx"
        fso.CopyFile ThisWorkbook.Path & "\Temp.xlsx", strFile, True
        cn.Close
        cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""Excel 12.0;HDR=No"";")
        For iCl = LBound(tblName) To UBound(tblName)
            cn.Execute ("Insert Into [" & tblName(iCl) & "] select * from [Excel 12.0;HDR=No;Database=" & ThisWorkbook.FullName & "].[" & tblName(iCl) & "] where F1='" & strSP & "'")
        Next
    Next
  
End Sub

Tải file, giải nén và mở file [File Gốc.xlsm] rồi chạy code nhé

be09 đã viết:
Nó hiện thông báo như thế này:
Trang này hiện không hoạt động.

Bình thường mà anh.

be_09 · 23/10/17

Hai Lúa Miền Tây đã viết:
Bạn tạo 1 file gọi là Temp, ...................
...........................................................................................
Bình thường mà anh.

Máy anh vẫn không vào sửa để xóa File cũ được, vẫn bị lỗi thế này đây.

Hai Lúa Miền Tây · 23/10/17

be09 đã viết:
Máy anh vẫn không vào sửa để xóa File cũ được, vẫn bị lỗi thế này đây.

View attachment 185333 View attachment 185334

Em thấy cái thông báo nó chặn gì đó. Anh thử dùng trình duyệt khác thay vì dùng Chrome xem sao nhé.

be_09 · 23/10/17

Hai Lúa Miền Tây đã viết:
Em thấy cái thông báo nó chặn gì đó. Anh thử dùng trình duyệt khác thay vì dùng Chrome xem sao nhé.

Anh vào Internet Explorer đăng nhập và thao tác thì được rồi (cám ơn em).

camlam06 · 30/10/17

Các anh chị cho em hỏi, ngoài phương pháp dùng file temp như của anh Hai Lúa Miền Tây, thì còn cách nào khác không ạ

camlam06 · 1/11/17

Có anh chị nào giúp em được không ạ

tueyennhi · 2/11/17

Hai Lúa Miền Tây đã viết:

Bạn tạo 1 file gọi là Temp, sau đó dùng code sau để copy file Temp đó tương ứng với mỗi sản phẩm, rồi cũng đồng thời đưa dữ liệu vào tương ứng.

PHP:

Sub LocDL_HLMT()
    Dim cn, rst, fso As Object
    Dim strSP, strFile As String
    Dim rstNum, i, iCl As Integer
    Dim tblName
    Dim arrSp As Variant
 
    Set cn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    Set fso = CreateObject("Scripting.FileSystemObject")
    tblName = Array("Xuat$", "Nhap$", "Ton$")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"";")
    rst.Open ("Select F1 from [Xuat$A3:A] where F1 Is Not Null union Select F1 from [Nhap$A3:A] where F1 Is Not Null union Select F1 from [Ton$A3:A] where F1 Is Not Null"), cn, 1
    arrSp = rst.GetRows()
    rstNum = rst.RecordCount - 1
    For i = 0 To rstNum
        strSP = arrSp(0, i)
        strFile = ThisWorkbook.Path & "\" & strSP & ".xlsx"
        fso.CopyFile ThisWorkbook.Path & "\Temp.xlsx", strFile, True
        cn.Close
        cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""Excel 12.0;HDR=No"";")
        For iCl = LBound(tblName) To UBound(tblName)
            cn.Execute ("Insert Into [" & tblName(iCl) & "] select * from [Excel 12.0;HDR=No;Database=" & ThisWorkbook.FullName & "].[" & tblName(iCl) & "] where F1='" & strSP & "'")
        Next
    Next
 
End Sub

Tải file, giải nén và mở file [File Gốc.xlsm] rồi chạy code nhé

Bình thường mà anh.

Anh xem giúp em với. Em sửa đôi chỗ mò theo file mẫu của anh mà nó báo lỗi ở dòng lện

PHP:

cn.Execute ("Insert Into [" & tblName(iCl) & "] select * from [Excel 12.0;HDR=No;Database=" & ThisWorkbook.FullName & "].[" & tblName(iCl) & "] where F1='" & strSP & "'")

Khác biệt ở đây là file của anh dựa theo cột A nhưng file của em dựa theo cột E.

tueyennhi · 2/11/17

camlam06 đã viết:
Có anh chị nào giúp em được không ạ

Vấn đề của bạn được Anh Hai Lúa Miền Tây giải quyết ở #9 rồi mà.

tueyennhi · 3/11/17

Có ai có thể chỉ giúp em ở bài #15 với

Hai Lúa Miền Tây · 3/11/17

tueyennhi đã viết:
Anh xem giúp em với. Em sửa đôi chỗ mò theo file mẫu của anh mà nó báo lỗi ở dòng lện

PHP:

cn.Execute ("Insert Into [" & tblName(iCl) & "] select * from [Excel 12.0;HDR=No;Database=" & ThisWorkbook.FullName & "].[" & tblName(iCl) & "] where F1='" & strSP & "'")

Khác biệt ở đây là file của anh dựa theo cột A nhưng file của em dựa theo cột E.

Chỉnh lại F1 của code trên thành F5:

Mã:

cn.Execute ("Insert Into [" & tblName(iCl) & "] select * from [Excel 12.0;HDR=No;Database=" & ThisWorkbook.FullName & "].[" & tblName(iCl) & "] where F5='" & strSP & "'")

tueyennhi · 3/11/17

Hai Lúa Miền Tây đã viết:
Chỉnh lại F1 của code trên thành F5:

Mã:

cn.Execute ("Insert Into [" & tblName(iCl) & "] select * from [Excel 12.0;HDR=No;Database=" & ThisWorkbook.FullName & "].[" & tblName(iCl) & "] where F5='" & strSP & "'")

Ngon lành rồi anh ạ, em thắc mắc thêm nếu file temp của em vẫn để định dạng (kẻ ô) nhưng không có dữ liệu. Tuy nhiên khi bấm tách thì dữ liệu tự động được cho vào dòng sau dòng định dạng cuối cùng là sao anh nhỉ? Có cách nào để định dạng được kẻ ô cho vùng được chuyển sang không anh?

camlam06 · 8/11/17

tueyennhi đã viết:
Vấn đề của bạn được Anh Hai Lúa Miền Tây giải quyết ở #9 rồi mà.

Ở #9 anh Hai Lúa đã giải quyết, code chạy rất nhanh, nhưng vấn đề em gặp là file temp không thể định dạng được, tương tự như ở #19 đang thắc mắc. Ý em là có cách nào vẫn duy trì được định dạng file temp như file gốc không ?

Lọc sản phẩm ở nhiều sheet và lưu thành file riêng

Thành viên mới

File đính kèm

Thành viên mới

❆❆❆❆❆❆❆❆

Ăn cùng góc phố

Thành viên mới

File đính kèm

Chuyên gia GPE

Thành viên mới

Biên Hòa, Đồng Nai

❆❆❆❆❆❆❆❆

File đính kèm

Biên Hòa, Đồng Nai

❆❆❆❆❆❆❆❆

Biên Hòa, Đồng Nai

Thành viên mới

Thành viên mới

Thành viên tích cực

File đính kèm

Thành viên tích cực

Thành viên tích cực

❆❆❆❆❆❆❆❆

Thành viên tích cực

Thành viên mới

Facebook

Group