Tách 1 file tổng thành 9 file nhỏ (4 người xem)

[teutamteu]

[FONT=&quot]Em chào mọi người.[/FONT]
[FONT=&quot]Em đang làm số liệu báo cáo xuất hàng cho sếp nhưng kém excel [/FONT][FONT=&quot] [/FONT][FONT=&quot]nên mỗi lần làm là mất 2h-3h, hix
[/FONT]
[FONT=&quot]Em có 3 file[/FONT]

• [FONT=&quot]File gốc em nhận từ phòng hệ thống họ gửi xuống: “Phong he thong gui_So lieu chuyen hang ngay 8 6.xls”
  [/FONT]

• [FONT=&quot]Em sẽ xử lý bước 1 bằng cách dùng hàm vlookup để lấy danh sách khu vực quản lý từ file “Vlookup lay khu vuc.xls” sau đó sẽ có kết quả như file “Xu ly buoc 1_So lieu chuyen hang ngay 8 6.xls”.[/FONT]

• [FONT=&quot]Sau tách được các khu vực em phải tách ra thành 9 file để gửi cho 9 khu vực (mỗi khu vực chỉ có số liệu của mình nó không lẫn các khu vực khác). Vd như file “Khu vuc 4_So lieu chuyen hang ngay 8 6.xls”[/FONT]

[FONT=&quot]Các bác xem có cách nào tạo sẵn các file với các hàm để khi em đổ dữ liệu phòng hệ thống gửi cái là có 9 file số liệu ngay không ạ.[/FONT]
[FONT=&quot]Hiện tại em mới quản lý 6 dịch vụ. Một ngày đẹp trời số dịch vụ mà nhiều hơn thì chắc mất cả đêm quá, híc
[/FONT]
[FONT=&quot]Em cám ơn mọi người nhiều.[/FONT]

 

[tienhue0209]

Tổng hợp khu vực

Bạn thử dùng pivottable xem. Hang thang ban chi phai lam dong tác copy từng dịch vụ vào 1 sheet tổng hợp, sau đó dùng công cụ pivottable.
bạn gửi địa chỉ mail mình sẽ gửi lại file cho bạn. (duytien169@yahoo.com)

chúc bạn thành công
DT

 

[teutamteu]

bạn có thể làm và đính kèm file luôn lên đây được mà ^_^
cho anh em khác tham khảo lun

 

[tintam7251]

-Thử làm theo yêu cầu của bạn, không biết đã đúng ý chưa?
-Trong khi chạy thử, phát hiện Mã T008 không tồn tại, bạn xem lại
-9 file được tách nằm trong thư mục khuvuc1-9.
-Tên, vị trí của file và folder nên giữ nguyên, muốn đổi phải sửa lại code.

 

[teutamteu]

-Thử làm theo yêu cầu của bạn, không biết đã đúng ý chưa?
-Trong khi chạy thử, phát hiện Mã T008 không tồn tại, bạn xem lại
-9 file được tách nằm trong thư mục khuvuc1-9.
-Tên, vị trí của file và folder nên giữ nguyên, muốn đổi phải sửa lại code.

Dúng yêu cầu này rồi bạn ạ, bạn có thể chia sẻ code để mình áp dụng các trường hợp sau không?

 

[tintam7251]

Bạn mở file, bấm Alt+F11 sẽ thấy code.

 

[teutamteu]

Đây là code, mọi người ai biết thì áp dụng tiếp nhé. Như mình đọc không hiểu nổi, VB học cách từ 2002 rùi, bao nhiêu năm đi làm không dùng gì đến nó nên giờ đọc lại tịt lun, không biết áp dụng cho các khác sẽ thế nào, híc

Dim p1 As String, p2 As String
Dim Wsh As Worksheet, Wb As Workbook
Sub Ad_Khuvuc()
Dim FileKV As Workbook
p1 = ThisWorkbook.Path
p2 = p1 & "\" & "khuvuc.xls"
Set FileKV = Application.Workbooks.Open(p2)
iRow7 = FileKV.Sheets("KV quan ly").Range("C65000").End(xlUp).Row
With ThisWorkbook
For Each Wsh In .Worksheets
iRow = Wsh.Range("B65000").End(xlUp).Row
For i = 3 To iRow
Set rng = FileKV.Sheets("KV quan ly").Range("C2:C" & iRow7).Find(Wsh.Cells(i, 2), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then
Wsh.Cells(i, 6) = FileKV.Sheets("KV quan ly").Cells(rng.Row, 4)
Else
Wsh.Cells(i, 6) = "Ma tinh" & Wsh.Cells(i, 2) & " nay khong ton tai"
End If
Next
Next
End With
Workbooks("khuvuc.xls").Close SaveChanges:=False
End Sub
Sub AutoFi_Taofile()
p1 = ThisWorkbook.Path
Application.ScreenUpdating = False
For sofile = 1 To 9
j = 1
With Application
.SheetsInNewWorkbook = 6
Set Wb = .Workbooks.Add
End With
With ThisWorkbook
For Each Wsh In .Worksheets
Wsh.Activate
Wsh.UsedRange.Offset(1).AutoFilter Field:=6, Criteria1:=sofile
Set rng = Wsh.AutoFilter.Range
rng.Offset(-1, 0).Resize(rng.Rows.Count + 1).Copy _
Destination:=Wb.Worksheets("Sheet" & j).Range("A1")
With Wb.Worksheets("Sheet" & j)
.Columns.AutoFit
.Name = Wsh.Name
End With
j = j + 1
If sofile = 9 Then Wsh.AutoFilterMode = False
Next
End With
Wb.SaveAs Filename:=p1 & "\" & "khuvuc1-9" & "\" & "khuvuc" & sofile & " .xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Wb.Close
Next
Sheet1.Activate
Application.ScreenUpdating = True
End Sub
Sub xoafile()
Dim FolderName As String, wbName As String
Dim t As Integer, m As Integer
FolderName = ActiveWorkbook.Path & "\khuvuc1-9"
wbName = Dir(FolderName & "\" & "*.xls")
Application.ScreenUpdating = False
While wbName <> ""
Application.DisplayAlerts = False
Kill FolderName & "\" & wbName
wbName = Dir
Wend
Application.ScreenUpdating = True
End Sub

 

[thuatnguyen]

Em cũng gặp vấn đề tương tự như bạn teutamteu nhưng hơi phức tạp hơn xíu mong mọi người giúp đỡ.

em có file như đính kèm với Sheet Detail và muốn tách file này những file con theo Mã dịch vụ ( lấy tên file con là Mã dịch vụ luôn), và trong mỗi file con đó có các sheet ứng với mã tỉnh (tên mỗi sheet là Mã Tỉnh luôn). mong các Anh/Chị giúp đỡ
cám ơn các Anh/Chị.

 

[tintam7251]

Em cũng gặp vấn đề tương tự như bạn teutamteu nhưng hơi phức tạp hơn xíu mong mọi người giúp đỡ.

Mình chỉnh code lại như sau:

Option Explicit
Sub AutoFi_Taofile()
Dim p1 As String
Dim Wsh As Worksheet, Wb As Workbook
Dim ArrFile(), ArrSheet()
Dim Rng0 As Range, Rng1 As Range, Rng2 As Range
Dim soFile As Integer, soSheet As Integer, j As Long
p1 = ThisWorkbook.Path
  Application.ScreenUpdating = False
  Frm_Progress.Show
  With Sheet1
    ArrFile = UniArray(.Range(.[a3], .[A65536].End(xlUp)))
       For soFile = 0 To UBound(ArrFile)
          .UsedRange.Offset(1).AutoFilter Field:=1, Criteria1:=ArrFile(soFile)
          Set Rng0 = .AutoFilter.Range
          Set Rng1 = Rng0.Offset(, 1).Resize(, 1)
          ArrSheet = UniArray(Rng1)
          soSheet = UBound(ArrSheet)
                With Application
                   .SheetsInNewWorkbook = soSheet
                    Set Wb = .Workbooks.Add
                End With
            For j = 1 To soSheet
               Rng0.AutoFilter Field:=2, Criteria1:=ArrSheet(j)
               Set Rng2 = .AutoFilter.Range
               Rng2.Offset(-1, 0).Resize(Rng2.Rows.Count + 1).Copy _
     Destination:=Wb.Worksheets("Sheet" & j).Range("A1")
                With Wb.Worksheets("Sheet" & j)
                   .Columns.AutoFit
                   .Name = ArrSheet(j)
            End With
          Next
             .AutoFilterMode = False
     Wb.SaveAs Filename:=p1 & "\" & "ketqua" & "\" & ArrFile(soFile) & " .xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
     Wb.Close
Frm_Progress.ProgressBar (soFile / UBound(ArrFile))
Next
Frm_Progress.Hide
End With
Application.ScreenUpdating = True
End Sub

Sub xoafile()
Dim FolderName As String, wbName As String
FolderName = ActiveWorkbook.Path & "\ketqua"
wbName = Dir(FolderName & "\" & "*.xls")
Application.ScreenUpdating = False
While wbName <> ""
          Application.DisplayAlerts = False
         Kill FolderName & "\" & wbName
        wbName = Dir
 Wend
Application.ScreenUpdating = True
End Sub

Function UniArray(vung As Range)
Dim Arr(), i As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Arr = vung.Value
For i = 1 To UBound(Arr)
  If Not Dic.exists(Arr(i, 1)) Then
    Dic.Add Arr(i, 1), ""
  End If
Next
 UniArray = Dic.keys
End Function

 

[thuatnguyen]

Em Cám ơn TinTam7251 rất nhiều.

Anh có thể giúp em sửa lại Code ở chổ khi tạo mỗi file con thì file con này chỉ gồm những sheet là Mã tỉnh thuộc Mã Dịch vụ đó, không tạo sheet với những mã tỉnh không thuộc mã dịch vụ đó ( vì Mã tỉnh thuộc mã dịch vụ này thì không thuộc mã dịch vụ khác).

Thanks.

 

[tintam7251]

Đã chỉnh lại theo ý của bạn. Bạn chạy và kiểm tra dùm xem còn có vấn đề gì nữa không?

 

[thuatnguyen]

Vô cùng cảm kích TinTam7251.

Chân Thành Cám Ơn Anh, đã đúng với mong đợi của em rồi ạ, hi vọng những ai đang gặp vấn đề chia tách file đọc được Topic này.

 

[teutamteu]

Về ý đồ thì ok rồi nhưng vấn đề là đọc code không hiểu nên nếu mà mai họ chèn thêm vài cột vài dòng vào nữa chắc lúc đó không chạy nổi nữa rồi.
híc
Dù sao vẫn chân thành cám ơn tintam7251 giúp đỡ.

 

[thuatnguyen]

Trong quá trình sử dụng rất tuyệt vời chỉ gặp duy nhất một lỗi nhỏ nếu Anh có ghé thăm chủ đề có thể khắc phục giúp. đó là khi tách thành 2 file nhỏ trở lên thì ok, nhưng khi chỉ muốn tách sheet thôi thì báo lỗi, ( 1file và tách ra các sheet con trong file) , thanks Anh,

 

[tintam7251]

-Theo mình hiểu thì bạn muốn tách từ 1 sheet trong 1 file thành nhiều sheet. Chương trình trên chỉ thực hiện tách 1 file thành nhiều file. Muốn tách sheet, bạn phải gởi file mẫu lên và nêu rõ yêu cầu thì người khác mới có thể giúp bạn được

 

[thuatnguyen]

Chân thành Cám ơn tintam7251 đã quan tâm,

Trong công việc của mình yêu cầu là từ 1 sheet detail như file gửi kèm (dựa vào cột A để chia file con và dựa vào cột B tách sheet trong mỗi file con đó)

Ví dụ: Cột A là Khu vực (có 3 KV bắc, trung, nam), Cột B là mã tỉnh (mỗi mã tỉnh là 1 sheet trong file con).

Mình muốn tách thành 4 file, mỗi khu vực là một file (có 3 file)--> để gửi đi 3 khu vực và 1 file tổng gồm sheet detail ban đầu và các sheet là mã tỉnh tương ứng --> gửi CEO.

Vì có nhiều file cần phải tách như vậy nếu có cách nào khi chia file thì mỗi file con chạy vào mỗi Folder tương ứng sẽ càng tuyệt vời hơn. Bạn xem giúp nhé, Cám ơn bạn rất nhiều.

 

[tintam7251]

Đã chỉnh theo yêu cầu của bạn. Chú ý việc nhập liệu phải chuẩn, nhất là nhập tiếng Việt thì chương trình mới chạy chính xác được. Bạn kiểm tra, có gì mình sẽ chỉnh tiếp.

 

[thuatnguyen]

Em Cám ơn tintam7251 rất nhiều,
Em sorry là hôm trước em trình bày chưa được đầy đủ lắm, hi vọng lần này là đầy đủ để tintam7251 không mất thêm thời gian.

Report của em được lấy ra từ Access nên không phải nhập liệu (và tên file cũng không cần tiếng việt có dấu), và em có 3 report cần phải tách ra như vậy (mỗi report tách thành 4 file).

Ví dụ 3 Report có tên tương ứng Report_1 đến Report_3 , và cột A của mỗi Report với thông tin:
- Report_1 Với Cột A là Report_1_Mien_Bac; Report_1_Mien_Nam; Report_1_Mien_Trung
- Report_2 Với Cột A là Report_2_Mien_Bac; Report_2_Mien_Nam; Report_2_Mien_Trung
- Report_3 Với Cột A là Report_3_Mien_Bac; Report_3_Mien_Nam; Report_3_Mien_Trung

Cột B là mã tỉnh dùng đặt tên Sheet trong file con.

Và khi muốn tách Report_1 thì Coppy Report_1 cho vào tools bấm nút CHIA FILE thì 4 file con Chạy vào 4 Folder tương ướng (CEO; Mien bac; Mien nam và Mien trung ).

Tương tự cho Report_2 nhưng vẫn giữ lại 4 file con của Report_1 trong 4 Folder
Tương tự cho Report_3 nhưng vẫn giữ lại 8 file con của Report_1 và Report_2 trong 4 Folder.

Cuối cùng mỗi Folder sẽ có 3 file tương ứng với Report_1 đến Report_3.

Tintam7251 có thể thêm giúp em nút Xóa ở Tools khi bấm nút Xóa này thì các file ở 4 Folder bị xóa sạch.

Em chân thành cám ơn.

 

[tintam7251]

Bạn cần làm rõ thêm một số điểm:
1. Report_1, Report_2, Report_3 có phải là tên của các file muốn tách không? Nếu phải, bạn gởi 3 file mẫu này lên cho mình.
2.

Và khi muốn tách Report_1 thì Coppy Report_1 cho vào tools ...

Tools là tên file chứa chương trình chính có thể xử lý dữ liệu của file khác nên không cần phải copy. Ý bạn thế nào?

 

[quybl]

sao khong dung autofilter roi coppy no sang 1 sheet khac tao cac sheet tu 1 9 la om roi cac ban oi