Tách 1 file thành nhiều file có điều kiện

[hpkhuong]

[COLOR=#000000][I]Workbooks.Add(1)[/I][/COLOR]

là lệnh tạo file mới có đúng 1 sheet và không liên quan đến thiết lập của người dùng , nó khác với

[COLOR=#000000][I]Workbooks.Add [/I][/COLOR]

bạn chạy code trên không ra kết quả thì cần xem lại ăn ở ra sao ?

Kaka. Đã tìm ra nguyên nhân...là vì sao:
Là vì do tác giả trên nói rằng tên sheet theo cột CI, tên File theo cột CJ. Mà thực tế thì cột CJ khác CI (có thể tác làm gọn lại cho dễ nhìn.). (Nhưng file trên #1 thì tác giả lại vô tình để nó trùng rùi.)
Cho nên khi lúc tôi viết code đã chỉnh cột CJ sang tên khác cột CI.
Và đã chạy code của bạn + của anh NDU trên file cũ nên nó hok có ra là đúng rồi.

Vậy thì: Code của bạn & của anh NDU chỉ chưa xét tới trường hợp là đặt tên file theo cột CJ chứ hok phải theo cột CI

Code của anh NDU thì đọc qua thấy anh set tên file là cột CJ nhưng nếu đổi tên tại cột CJ khác cột CI thì code lại chạy hok ra file nào hết như mình nói ở trên

Chắc chờ anh í vào xem lại! keke....

 

[ndu96081631]

thì phải vậy mới gọi là trò của thầy chứ ! hi hi

Nói quá rồi đại ca ơi!
Chẳng thích ai gọi mình bằng thầy tí nào. Bạn bè hay anh em gì đó thấy thoải mái hơn

 

[saobekhonglac]

Đúng rồi. Cột CJ sẽ ngắn gọn hơn cột CI (do lúc đầu em làm biếng mới copy cho giống CI cho nhanh, chứ thực tế thì CJ và CI khác nhau).

Cám ơn mấy anh nhiều.

Kaka. Đã tìm ra nguyên nhân...là vì sao:
Là vì do tác giả trên nói rằng tên sheet theo cột CI, tên File theo cột CJ. Mà thực tế thì cột CJ khác CI (có thể tác làm gọn lại cho dễ nhìn.). (Nhưng file trên #1 thì tác giả lại vô tình để nó trùng rùi.)
Cho nên khi lúc tôi viết code đã chỉnh cột CJ sang tên khác cột CI.
Và đã chạy code của bạn + của anh NDU trên file cũ nên nó hok có ra là đúng rồi.

Vậy thì: Code của bạn & của anh NDU chỉ chưa xét tới trường hợp là đặt tên file theo cột CJ chứ hok phải theo cột CI

Code của anh NDU thì đọc qua thấy anh set tên file là cột CJ nhưng nếu đổi tên tại cột CJ khác cột CI thì code lại chạy hok ra file nào hết như mình nói ở trên

Chắc chờ anh í vào xem lại! keke....

 

[ndu96081631]

Chắc chờ anh í vào xem lại! keke....

Thử sửa chỗ:

If Len(aIDs(n, 1)) [COLOR=#ff0000]And[/COLOR] Len(aIDs(n, 2)) Then

Thành vầy xem sao:

If Len(aIDs(n, 1)) [COLOR=#ff0000]*[/COLOR] Len(aIDs(n, 2)) Then

 

[doveandrose]

Nói quá rồi đại ca ơi!
Chẳng thích ai gọi mình bằng thầy tí nào. Bạn bè hay anh em gì đó thấy thoải mái hơn

cảm ơn thầy đã nói ra suy nghĩ . Trong âm thầm em quan sát và học tập kiến thức của thầy nhiều hơn học bất cứ ai ở diễn đàn này nên luôn trân trọng và biết ơn để gọi chữ thầy . Nhưng nếu thầy đã nói vậy thì đây là lần cuối
từ nay sẽ là anh NDU thân mến . hi hi

 

[saobekhonglac]

Anh NDU ơi.

Anh xem giúp em nếu em thay đổi tên ở cột CJ thì xuất ra nó chỉ ra đúng 1 tên nhóm 1 và 1 tên nhóm 2, những cái khác cùng tên nó sẽ bị đè lên nhau. Anh xem lại giúp em.

Anh sửa lại giúp em theo điều kiện sau:

1 code sẽ xuất dữ liệu sẽ xuất từ cột A đến CH và lấy tên file theo điều kiện cột CI (xuất 12 file: từ Nguyễn Văn 1 đến Nguyễn Văn 12).
1 code sẽ xuất dữ liệu sẽ xuất từ cột A đến CH và lấy tên file theo điều kiện cột CJ (xuất 2 file: file NHOM1 & NHOM2).

Cám ơn anh.

Gọn trong cách tiếp cận vấn đề! Tôi làm vầy:

Sub Main()
  Dim dic As Object, rngSrc As Range, wkbNew As Workbook
  Dim aIDs, n As Long
  Dim sFolder As String, FileName As String, SheetName As String
  sFolder = ThisWorkbook.Path & "\"
  Set rngSrc = ThisWorkbook.Worksheets("Sum").Range("A1:CJ10000")
  aIDs = rngSrc.Offset(1).Columns("CI:CJ").Value
  Set dic = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  rngSrc.Range("IV1").Value = rngSrc.Range("CI1").Value
  For n = 1 To UBound(aIDs, 1)
    If Len(aIDs(n, 1)) * Len(aIDs(n, 2)) Then
      SheetName = aIDs(n, 1):  FileName = aIDs(n, 2)
      If Not dic.Exists(SheetName) Then
        dic.Add SheetName, Empty
        Set wkbNew = Workbooks.Add(1)
        wkbNew.Sheets(1).Name = SheetName
        rngSrc.Range("IV2").Value = "'=" & SheetName
        rngSrc.AdvancedFilter 2, rngSrc.Range("IV1:IV2"), wkbNew.Sheets(1).Range("A1")
        wkbNew.SaveAs sFolder & FileName, xlOpenXMLWorkbook
        wkbNew.Close False
      End If
    End If
  Next
  Application.ScreenUpdating = True
  rngSrc.Range("IV1:IV2").ClearContents
  If dic.Count Then MsgBox "Ða luu " & dic.Count & " workbooks", , "THÔNG BÁO"
End Sub

Không phải "gọn" là "ngắn" đâu
------------------
Giải thuật đơn giản:
- Ta duyệt cột CI rồi add vào dic
- Cứ mỗi lần add được thứ gì đó vào dic, ta lại tạo 1 workbook mới, dùng công cụ AF lọc theo điều kiện (vừa add vào dic) sang workbook mới tạo (lọc luôn chứ không cần phải copy gì cả)
- Lưu workbook mới thành file
Vậy thôi
-----------------
Có 1 vài việc cần lưu ý:
- Do ta chỉ lưu mỗi file có 1 sheet nên khi tạo workbook, bằng cách nào đó ta phải tạo nó chỉ chứa 1 sheet thôi
- Code trên chưa bẫy lỗi, đúng ra ta phải xét tính hợp lệ của tên sheet (nếu không thì làm sao đặt tên).
- Cả tên file của phải lưu ý về tính hợp lệ này và còn vấn đề nếu file ta chuẩn bị lưu đã tồn tại trước đó thì sao? Cho lưu đè hay bỏ qua? Đó là lúc mà ta cho chạy code từ lần thứ 2 trở đi sẽ có vấn đề cần bàn..
vân.. vân...

 

[saobekhonglac]

Có ai giúp mình với. .................

Anh NDU ơi.

Anh xem giúp em nếu em thay đổi tên ở cột CJ thì xuất ra nó chỉ ra đúng 1 tên nhóm 1 và 1 tên nhóm 2, những cái khác cùng tên nó sẽ bị đè lên nhau. Anh xem lại giúp em.

Anh sửa lại giúp em theo điều kiện sau:

1 code sẽ xuất dữ liệu sẽ xuất từ cột A đến CH và lấy tên file theo điều kiện cột CI (xuất 12 file: từ Nguyễn Văn 1 đến Nguyễn Văn 12).
1 code sẽ xuất dữ liệu sẽ xuất từ cột A đến CH và lấy tên file theo điều kiện cột CJ (xuất 2 file: file NHOM1 & NHOM2).

Cám ơn anh.

 

[saobekhonglac]

Anh NDU ơi, anh vào giúp em với.

 

[Ai_Ma_Biet]

Không biết về VBA nên không chỉ được nhưng theo tôi biết thì cột CI là cột lọc điều kiện để xuất, còn cột CJ là cột lưu tên file, nếu trùng tên thì nó chỉ lưu 1 tên là đúng. Bạn ngồi chờ tác giả giúp bạn thôi

Anh NDU ơi.

Anh xem giúp em nếu em thay đổi tên ở cột CJ thì xuất ra nó chỉ ra đúng 1 tên nhóm 1 và 1 tên nhóm 2, những cái khác cùng tên nó sẽ bị đè lên nhau. Anh xem lại giúp em.

Anh sửa lại giúp em theo điều kiện sau:

1 code sẽ xuất dữ liệu sẽ xuất từ cột A đến CH và lấy tên file theo điều kiện cột CI (xuất 12 file: từ Nguyễn Văn 1 đến Nguyễn Văn 12).
1 code sẽ xuất dữ liệu sẽ xuất từ cột A đến CH và lấy tên file theo điều kiện cột CJ (xuất 2 file: file NHOM1 & NHOM2).

Cám ơn anh.

 

[saobekhonglac]

Cám ơn bạn, đành phải ngồi chờ anh NDU thôi chứ biết sau giờ.

Không biết về VBA nên không chỉ được nhưng theo tôi biết thì cột CI là cột lọc điều kiện để xuất, còn cột CJ là cột lưu tên file, nếu trùng tên thì nó chỉ lưu 1 tên là đúng. Bạn ngồi chờ tác giả giúp bạn thôi

 

[hpkhuong]

Anh NDU ơi.

Anh xem giúp em nếu em thay đổi tên ở cột CJ thì xuất ra nó chỉ ra đúng 1 tên nhóm 1 và 1 tên nhóm 2, những cái khác cùng tên nó sẽ bị đè lên nhau. Anh xem lại giúp em.

Anh sửa lại giúp em theo điều kiện sau:

1 code sẽ xuất dữ liệu sẽ xuất từ cột A đến CH và lấy tên file theo điều kiện cột CI (xuất 12 file: từ Nguyễn Văn 1 đến Nguyễn Văn 12).
1 code sẽ xuất dữ liệu sẽ xuất từ cột A đến CH và lấy tên file theo điều kiện cột CJ (xuất 2 file: file NHOM1 & NHOM2).

Cám ơn anh.

1. Xuất tên thì tìm dòng này và sửa thành:

SheetName = aIDs(n, 1): FileName = aIDs(n, 2)

Sửa thành
SheetName = aIDs(n, 1): FileName = aIDs(n, 1)

2. Xuất theo nhóm thì tìm dòng:

rngSrc.Range("IV1").Value = rngSrc.Range("CI1").Value

Sửa thành: rngSrc.Range("IV1").Value = rngSrc.Range("CJ1").Value

SheetName = aIDs(n, 1): FileName = aIDs(n, 2)

Sửa thành: SheetName = aIDs(n, 2): FileName = aIDs(n, 2)

 

[Mss.Happy]

em thấy cũng vậy chứ có gọn hơn gì đâu

Public Sub hello()
Dim dic As Object, r As Long, arr, lr As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set dic = CreateObject("Scripting.Dictionary")
With Sheet1
    lr = .[CJ65000].End(xlUp).Row
    arr = .Range("CJ2:CJ" & lr).Value
    .Copy , Sheet1
    For r = 1 To UBound(arr) Step 1
        If Len(arr(r, 1)) > 0 Then
            If Not dic.exists(arr(r, 1)) Then
                dic(arr(r, 1)) = 1
                .[ZZ2].Value = "=CJ2=""" & arr(r, 1) & """"
                .Range("A1:CJ" & lr).AdvancedFilter xlFilterCopy, .[ZZ1:ZZ2], ActiveSheet.[A1:CJ1], False
                ActiveSheet.Copy
                ActiveWorkbook.Worksheets(1).Name = .Name
                ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & arr(r, 1) & ".xlsx"
            End If
        End If
    Next
    .[ZZ2].ClearContents
End With
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Bạn ơi, mình chạy thử code của bạn, nó vẫn lưu được theo điều kiện filter thành các file khác nhau, nhưng nội dung bên trong thì y chang sheet dữ liệu ban đầu. Nhờ bạn chỉ giáo nhé

 

[DarkWanderer]

Bạn ơi, mình chạy thử code của bạn, nó vẫn lưu được theo điều kiện filter thành các file khác nhau, nhưng nội dung bên trong thì y chang sheet dữ liệu ban đầu. Nhờ bạn chỉ giáo nhé

Code ấy chưa hoàn chỉnh, bạn xem code của anh Ndu bên dưới ấy