Dò tìm theo mã để cập nhật dữ liệu (6 người xem)

[letuongqt]

Tôi có vấn đề như sau xin được các anh tư vấn và giúp cho :
Từ bảng danh sách tổng hợp chung các lớp toàn trường , tôi phải lọc trích riêng ra từng lớp để mỗi giáo viên phụ trách có trách nhiệm nhập điểm số vào (Họ có thể mang file trích về nhà để nhập - Tất nhiên file trích này có cùng định dạng với bảng tổng hợp ) .Sau khi nhập xong , từng người sẽ gởi về văn phòng để tôi phải coppy và dán vào bảng tổng hợp (Bảng tổng hợp ban đầu dùng để trích ra các lớp ) . Thông thường việc làm này rất mất thời gian , công sức và không chính xác .
Với suy nghĩ rằng , từ danh sach tổng hợp sẽ có 1 nút điều khiển , hoặc form gì đó ,... để khi bấm vào sẽ hiện lên đường dẫn đến file cần copy và dán ; Từ đây căn cứ vào Mã số học sinh , dò tìm (giữa bảng tổng hợp và bảng trích dò theo mã cột B) để điền vào đúng các dòng tương ứng (Ở đây dữ liệu cập nhật là điểm số ) . Nhờ các anh hướng dẫn và giúp đỡ cho , xin cảm ơn rất nhiều .

 

[ndu96081631]

Tôi có vấn đề như sau xin được các anh tư vấn và giúp cho :
Từ bảng danh sách tổng hợp chung các lớp toàn trường , tôi phải lọc trích riêng ra từng lớp để mỗi giáo viên phụ trách có trách nhiệm nhập điểm số vào (Họ có thể mang file trích về nhà để nhập - Tất nhiên file trích này có cùng định dạng với bảng tổng hợp ) .Sau khi nhập xong , từng người sẽ gởi về văn phòng để tôi phải coppy và dán vào bảng tổng hợp (Bảng tổng hợp ban đầu dùng để trích ra các lớp ) . Thông thường việc làm này rất mất thời gian , công sức và không chính xác .
Với suy nghĩ rằng , từ danh sach tổng hợp sẽ có 1 nút điều khiển , hoặc form gì đó ,... để khi bấm vào sẽ hiện lên đường dẫn đến file cần copy và dán ; Từ đây căn cứ vào Mã số học sinh , dò tìm (giữa bảng tổng hợp và bảng trích dò theo mã cột B) để điền vào đúng các dòng tương ứng (Ở đây dữ liệu cập nhật là điểm số ) . Nhờ các anh hướng dẫn và giúp đỡ cho , xin cảm ơn rất nhiều .

Đương nhiên việc này hoàn toàn khả thi... Tuy nhiên bạn nên đưa 1 vài file "con" lên để thử code chứ

 

[letuongqt]

Dò tìm theo mã để cập nhật dữ liệu Trả Lời Ðề Tài

Đương nhiên việc này hoàn toàn khả thi... Tuy nhiên bạn nên đưa 1 vài file "con" lên để thử code chứ

Xin cảm ơn ndu96081631 rất nhiều . Theo yêu cầu , tôi xin gởi file đã trích (file con) . Ở đây , để cho tiện tôi giả sử các file con gởi về để ở các sheet khác nhau (Thực tế : Đường dẫn đến các file này là bất kỳ : Vd ổ D:\ , E:\ , đĩa mềm ,... ) xin nhờ anh giúp cho phương án tổng quát nhất .

 

[ndu96081631]

Xin cảm ơn ndu96081631 rất nhiều . Theo yêu cầu , tôi xin gởi file đã trích (file con) . Ở đây , để cho tiện tôi giả sử các file con gởi về để ở các sheet khác nhau (Thực tế : Đường dẫn đến các file này là bất kỳ : Vd ổ D:\ , E:\ , đĩa mềm ,... ) xin nhờ anh giúp cho phương án tổng quát nhất .

File của bạn virus... đầy...
Tôi diệt xong và post lại đây ---> Bạn xóa file của bạn đi, kẻo người khác không biết tải về và mở ra thì khổ
Từ từ nghiên cứu xem ---> Trong khi chờ đợi, mong các cao thủ khác giúp 1 tay (tôi cũng hơi kém về việc lấy data từ file khác)

 

[letuongqt]

Xin lỗi ! vì file có virut - đã khắc phục xong .
Giải pháp để xử lý cho vấn đề cập nhật dữ liệu dựa vào mã tương ứng như tôi đã trình bày ở trên liệu có khả thi ? Hay có những giải pháp khác tốt hơn ,... từ trước tới nay tôi chỉ làm toàn bằng thủ công copy--> dán rất mệt. Xin nhờ các anh giúp hoặc tư vấn cho 1 phướng án khác tốt hơn ,... Xin cảm ơn rất nhiều .

 

[letuongqt]

Dò tìm theo mã để cập nhật dữ liệu Trả Lời Ðề Tài

File của bạn virus... đầy...
Tôi diệt xong và post lại đây ---> Bạn xóa file của bạn đi, kẻo người khác không biết tải về và mở ra thì khổ
Từ từ nghiên cứu xem ---> Trong khi chờ đợi, mong các cao thủ khác giúp 1 tay (tôi cũng hơi kém về việc lấy data từ file khác)

Xin lỗi tôi đã khắc phục file nhiễm vr xong .
Vấn đề này đi theo hướng giải quyết như tôi đã nêu ở trên liệu có khả thi ? Xin anh cho ý kiến . Rất cảm ơn .

 

[SA_DQ]

Xin giới thiệu macro chép từ mọi trang tính khác về trang 'TongHop'

Option Explicit
Sub CapNhat()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Clls As Range, Rng0 As Range
 
 Sheets("TongHop").Select
 Set Rng0 = Range([B2], [B65500].End(xlUp))
 Application.ScreenUpdating = False
 For Each Sh In Worksheets
   If Sh.Name <> "TongHop" Then
      Set Rng = Sh.Range(Sh.[B3], Sh.[B65500].End(xlUp))
      For Each Clls In Rng
         Set sRng = Rng0.Find(Clls.Value, , xlFormulas, xlWhole)
         If Not sRng Is Nothing Then
            sRng.Offset(, 3).Resize(, 16).Value = Clls.Offset(, 3).Resize(, 16).Value
         End If
      Next Clls
   End If
 Next Sh
End Sub

Vấn đề chép từ file này sang file khác thì theo tôi nên làm bằng tay, bằng mắt. Chẳng lẽ bạn không nghía dù 1 lần khi các giáo viên đưa file đã nhập điểm cho bạn?

 

[ndu96081631]

Option Explicit
Sub CapNhat()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Clls As Range, Rng0 As Range
 
 Sheets("TongHop").Select
 Set Rng0 = Range([B2], [B65500].End(xlUp))
 Application.ScreenUpdating = False
 For Each Sh In Worksheets
   If Sh.Name <> "TongHop" Then
      Set Rng = Sh.Range(Sh.[B3], Sh.[B65500].End(xlUp))
      For Each Clls In Rng
         Set sRng = Rng0.Find(Clls.Value, , xlFormulas, xlWhole)
         If Not sRng Is Nothing Then
            sRng.Offset(, 3).Resize(, 16).Value = Clls.Offset(, 3).Resize(, 16).Value
         End If
      Next Clls
   End If
 Next Sh
End Sub

Vấn đề chép từ file này sang file khác thì theo tôi nên làm bằng tay, bằng mắt. Chẳng lẽ bạn không nghía dù 1 lần khi các giáo viên đưa file đã nhập điểm cho bạn?

Hình như sư phụ hiểu lầm ý tác giả thì phải
- Thực chất là có 4 file: Tonghop.xls, 6A1.xls, 6A2.xls và 6A3.xls ---> Tác giả gôm chúng vào cùng 1 file cho dể upload thôi (trên thực tế vẫn có thể có nhiều file hơn)
- Nhiệm vụ của ta là viết code mở 1 Dialog chọn file ---> Tìm kiếm trong file vừa chọn rồi update vào file tổng hợp
(File Tonghop.xls là file chính, các file còn lại là file con, có thể nằm ở bất kỳ nơi đâu trong ổ đĩa )
Nói tóm lại, yêu cầu này có thể tóm tắt như sau: Dò tìm và tổng hợp dử liệu từ nhiều file vào 1 file

 

[letuongqt]

Xin cảm ơn ndu96081631 ,
đúng là như vậy . ở đây thực tế đường dẫn được lưu ở 1 file , thư mục nào đó (kể cả ổ đĩa khác nhau ,... ) .

 

[ChanhTQ@]

Hình như sư phụ hiểu lầm ý tác giả thì phải
- Thực chất là có 4 file: Tonghop.xls, 6A1.xls, 6A2.xls và 6A3.xls ---> Tác giả gôm chúng vào cùng 1 file cho dể upload thôi (trên thực tế vẫn có thể có nhiều file hơn)
- Nhiệm vụ của ta là viết code mở 1 Dialog chọn file ---> Tìm kiếm trong file vừa chọn rồi update vào file tổng hợp
(File Tonghop.xls là file chính, các file còn lại là file con, có thể nằm ở bất kỳ nơi đâu trong ổ đĩa )

Có lẽ không hề nhầm đâu;
Mà cách như vậy, chúng ta không biết các giáo viên đã nhập điểm cho lớp mình đúng chưa;
Lỡ giáo viên nào đó đưa file chưa nhập hay nhập sai, thay vì nhập điểm lại đi nhập các chữ cái;
Một khi ta tự động chép vô file tổng hợp hàng ngàn HS; Rồi nó báo lỗi thì phải tìm & kiếm, chứ sao?

Tự động hóa quá cũng phải có kiểm soát; nếu không có ngày toi luôn bảng Tổng hợp không chừng, Một khi thầy cô nào đó không được lên lương chẳng hạn, đưa cho con virus ! Kha, kha, . . .
Vui một tẹo í mà!

 

[ndu96081631]

Có lẽ không hề nhầm đâu;
Mà cách như vậy, chúng ta không biết các giáo viên đã nhập điểm cho lớp mình đúng chưa;
Lỡ giáo viên nào đó đưa file chưa nhập hay nhập sai, thay vì nhập điểm lại đi nhập các chữ cái;
Một khi ta tự động chép vô file tổng hợp hàng ngàn HS; Rồi nó báo lỗi thì phải tìm & kiếm, chứ sao?

Tự động hóa quá cũng phải có kiểm soát; nếu không có ngày toi luôn bảng Tổng hợp không chừng, Một khi thầy cô nào đó không được lên lương chẳng hạn, đưa cho con virus ! Kha, kha, . . .
Vui một tẹo í mà!

Nhưng yêu cầu của tác giả là THẾ mà sư phụ ---> Sư phụ lại làm khác đi thì làm sao người ta áp dụng được
Chẳng lẽ sư phụ bắt người ta COPY từng file 1 cho vào bảng tổng hợp, sau đó mới chạy code?

 

[ChanhTQ@]

Spam một tẹo!

Nhưng yêu cầu của tác giả là THẾ mà sư phụ ---> Sư phụ lại làm khác đi thì làm sao người ta áp dụng được
Chẳng lẽ sư phụ bắt người ta COPY từng file 1 cho vào bảng tổng hợp, sau đó mới chạy code?

Mình nghĩ là không nên bắt buộc người ta làm vậy; Chỉ là khuyến cáo nên làm vậy; Để có dịp kiểm soát quá trình; Quan liêu quá có ngày đổ nợ không chừng!

Còn việc iêu cầu ư, Cứ việc iêu cầu; còn có đáp ứng hay không thì là việc khác của mỗi người à nha! Khà, khà, . . .

 

[letuongqt]

-Dĩ nhiên , nói như anh ChanhTQ@ không sai . Tuy nhiên , đối với trường học -do đặc thù công công việc - thì việc cố tình làm những điều không đúng như anh nói là không xãy ra đâu (Vì chính công việc này là lợi ích chung của mọi người - Nghĩa là nếu anh cố tình làm sai hoặc có sai sót gì gì đó ... thì chính bản thân anh là người chịu thiệt thòi trước nhất ). Ngoài ra , sau khi GV nhập xong gởi về từng bộ phận (là tổ ) kiểm tra 1 lần cuối trước khi gởi đến bộ phân tổng hợp , vì vậy vấn đề này là kiểm soát được .
Vấn đề sợ khi nhập , kiểu dư liệu không đúng hoặc không thống nhất tôi nghĩ : chúng ta làm theo kiểu nếu dữ liệu ở file con dữ liệu như thế nào thì tìm và cập nhật như thế ấy - Chính là điều mong muốn ; ngoài ra ,ta có thể sử dụng chức năng sẵn có của Excel để bẫy lội trong khi nhập liệu (Data--> Validaton ,...) . Xin cảm ơn sự quan tâm của anh , rất mong được giúp đỡ tiếp .

 

[letuongqt]

Dò tìm theo mã để cập nhật dữ liệu Trả Lời Ðề Tài

Hình như sư phụ hiểu lầm ý tác giả thì phải
- Thực chất là có 4 file: Tonghop.xls, 6A1.xls, 6A2.xls và 6A3.xls ---> Tác giả gôm chúng vào cùng 1 file cho dể upload thôi (trên thực tế vẫn có thể có nhiều file hơn)
- Nhiệm vụ của ta là viết code mở 1 Dialog chọn file ---> Tìm kiếm trong file vừa chọn rồi update vào file tổng hợp
(File Tonghop.xls là file chính, các file còn lại là file con, có thể nằm ở bất kỳ nơi đâu trong ổ đĩa )
Nói tóm lại, yêu cầu này có thể tóm tắt như sau: Dò tìm và tổng hợp dử liệu từ nhiều file vào 1 file

Như vậy ,phuơng án này liệu có khả thi không vậy ndu96081631 ?, để biết còn phải theo đuổi tiếp tục hay không . Xin được góp ý , rất cảm ơn .

 

[ndu96081631]

Như vậy ,phuơng án này liệu có khả thi không vậy ndu96081631 ?, để biết còn phải theo đuổi tiếp tục hay không . Xin được góp ý , rất cảm ơn .

Đương nhiên là khả thi rồi... Thậm chí các sheet 6A1, 6A2 người ta cho hẳn vào 1 file khác cũng làm được luôn (tin chắc là vậy) ---> Chỉ có điều tôi hơi kém về phần lấy dử liệu từ file khác nên chưa dám ra tay
Bạn search trên diển đàn thử xem, có nhiều bài nói về vấn đề này đã từng đăng trên diển đàn rồi đấy

 

[ndu96081631]

Hôm nay tôi xem kỹ lại yêu cầu và thấy rằng bài này có thể dùng VLOOKUP để tổng hợp, ưu điểm của VLOOKUP là có thể dò tìm mà không cần mở file! Vấn đề là làm sao xác định được vị trí của các file con
Tôi kết hợp VLOOKUP với code VBA để làm bài này,,, bạn mở file chạy thử nhé! Quy trình như sau
- Khởi động file Tonghop.xls
- Bấm nút "Tổng hợp" để chạy code... một Dialog hiện ra cho phép bạn chọn file ---> Có thể chọn 1 file hoặc nhiêu file cùng lúc (bằng cách dùng chuột kết hợp với phím Shift để chọn)
Code như sau:

Sub Capnhat()
  Dim Item, CrtItem As String, FItem As String, FolItem As String, Temp As String
  On Error GoTo Thoat
  Application.ScreenUpdating = False
  With Application.FileDialog(1)
    .AllowMultiSelect = True: .Show
    For Each Item In .SelectedItems
      FolItem = .InitialFileName
      FItem = Replace(Item, FolItem, "")
      CrtItem = Replace(FItem, ".xls", "")
      With ThisWorkbook.Sheets("Tonghop")
        With .Range(.[A2], .[A65536].End(xlUp)).Resize(, 21)
          .AutoFilter 4, CrtItem
          With Intersect(.Cells, .Offset(1, 4))
            Temp = "VLOOKUP(RC2,'" & FolItem & "[" & FItem & "]" & CrtItem & "'!R3C2:R1000C21,COLUMN()-1,0)"
            .SpecialCells(12).Value = "=IF(" & Temp & "=0,""""," & Temp & ")"
            .AutoFilter
            .Value = .Value
          End With
        End With
      End With
    Next
  End With
Thoat:
  Application.ScreenUpdating = True
End Sub

-------------------
Lưu ý:
- Tất cả các file phải có cùng 1 cấu trúc như hiện tại
- Nếu có khác biệt, bạn vui lòng cho biết để sửa lại code
-------------------
Nói thêm: Từ file tổng hợp, tôi nghĩ bạn cũng phải có nhu cầu tách riêng mổi lớp ra 1 file (để người dùng nhập liệu) ---> Nếu có nhu cầu này, chúng ta sẽ tiếp tục với 1 code khác

 

[letuongqt]

Hôm nay tôi xem kỹ lại yêu cầu và thấy rằng bài này có thể dùng VLOOKUP để tổng hợp, ưu điểm của VLOOKUP là có thể dò tìm mà không cần mở file! Vấn đề là làm sao xác định được vị trí của các file con
Tôi kết hợp VLOOKUP với code VBA để làm bài này,,, bạn mở file chạy thử nhé! Quy trình như sau
- Khởi động file Tonghop.xls
- Bấm nút "Tổng hợp" để chạy code... một Dialog hiện ra cho phép bạn chọn file ---> Có thể chọn 1 file hoặc nhiêu file cùng lúc (bằng cách dùng chuột kết hợp với phím Shift để chọn)
Code như sau:

Sub Capnhat()
  Dim Item, CrtItem As String, FItem As String, FolItem As String, Temp As String
  On Error GoTo Thoat
  Application.ScreenUpdating = False
  With Application.FileDialog(1)
    .AllowMultiSelect = True: .Show
    For Each Item In .SelectedItems
      FolItem = .InitialFileName
      FItem = Replace(Item, FolItem, "")
      CrtItem = Replace(FItem, ".xls", "")
      With ThisWorkbook.Sheets("Tonghop")
        With .Range(.[A2], .[A65536].End(xlUp)).Resize(, 21)
          .AutoFilter 4, CrtItem
          With Intersect(.Cells, .Offset(1, 4))
            Temp = "VLOOKUP(RC2,'" & FolItem & "[" & FItem & "]" & CrtItem & "'!R3C2:R1000C21,COLUMN()-1,0)"
            .SpecialCells(12).Value = "=IF(" & Temp & "=0,""""," & Temp & ")"
            .AutoFilter
            .Value = .Value
          End With
        End With
      End With
    Next
  End With
Thoat:
  Application.ScreenUpdating = True
End Sub

-------------------
Lưu ý:
- Tất cả các file phải có cùng 1 cấu trúc như hiện tại
- Nếu có khác biệt, bạn vui lòng cho biết để sửa lại code
-------------------
Nói thêm: Từ file tổng hợp, tôi nghĩ bạn cũng phải có nhu cầu tách riêng mổi lớp ra 1 file (để người dùng nhập liệu) ---> Nếu có nhu cầu này, chúng ta sẽ tiếp tục với 1 code khác

Xin cảm ơn anh ndu96081631 rất nhiều ! Cách làm của anh thật tuyệt vời ( ngoài ra còn đoán được rất chính xác ý đồ của người khác nữa. Thực sự tôi cũng không dám yêu cầu gì quá nhiều (ngại làm phiền đến người giúp mình) , nhưng anh cũng đã hiểu được điều này , vậy sẵn anh gợi ý tôi xin nói thêm :
- Về cấu trúc file cơ bản vẫn như thế , nếu có thay đổi chỉ là thêm bớt trường tiêu đề .
- Thực tế : Các file con là file được trích ra từ file tổng hợp để gởi cho các bộ phận (cũng như những người nhập liệu) .Do vậy , ban đầu tôi chỉ nghĩ, việc này chỉ cấn làm thủ công hoặc 1 marco về copy và past gì đấy . Nếu được tích hợp luôn vào đoạn code như trên của anh thì quá tuyệt vời - và bằng một nút trích file gì đó -(Điều này vừa nhanh , gọn và đảm bảo tính đồng nhất của cấu trúc bảng nhập liệu) . Yêu cầu file trích ra: Trích ra theo từng cụm lớp (vd 1 file gồm các lớp : 6a1,6a3 ; 1 file khác là : 6a2 ...) do ta khai báo (Nghĩa là 1 GV có thể dạy nhiều lớp khác nhau - cần lấy ra để nhập) .
+ Dim Item, CrtItem As String, FItem As String, FolItem As String, Temp As String
With Application.FileDialog(1) - Chưa hiểu được cách khai báo này
Và xin được giải thích đoạn :
+ .AllowMultiSelect = True: .Show
For Each Item In .SelectedItems
FolItem = .InitialFileName
FItem = Replace(Item, FolItem, "")
CrtItem = Replace(FItem, ".xls", "")
With ThisWorkbook.Sheets("Tonghop")
With .Range(.[A2], .[A65536].End(xlUp)).Resize(, 21)
.AutoFilter 4, CrtItem
With Intersect(.Cells, .Offset(1, 4))
- Tôi chỉ mới tập tành học viết vài marco đơn giản thôi , sắn đây cũng là dịp học hỏi rất tốt cho bản thân ) .
Xin cảm ơn rất nhiều .

 

[ndu96081631]

Xin cảm ơn anh ndu96081631 rất nhiều ! Cách làm của anh thật tuyệt vời ( ngoài ra còn đoán được rất chính xác ý đồ của người khác nữa. Thực sự tôi cũng không dám yêu cầu gì quá nhiều (ngại làm phiền đến người giúp mình) , nhưng anh cũng đã hiểu được điều này , vậy sẵn anh gợi ý tôi xin nói thêm :
- Về cấu trúc file cơ bản vẫn như thế , nếu có thay đổi chỉ là thêm bớt trường tiêu đề .
- Thực tế : Các file con là file được trích ra từ file tổng hợp để gởi cho các bộ phận (cũng như những người nhập liệu) .Do vậy , ban đầu tôi chỉ nghĩ, việc này chỉ cấn làm thủ công hoặc 1 marco về copy và past gì đấy . Nếu được tích hợp luôn vào đoạn code như trên của anh thì quá tuyệt vời - và bằng một nút trích file gì đó -(Điều này vừa nhanh , gọn và đảm bảo tính đồng nhất của cấu trúc bảng nhập liệu) .
+ Dim Item, CrtItem As String, FItem As String, FolItem As String, Temp As String
With Application.FileDialog(1) - Chưa hiểu được cách khai báo này
Và xin được giải thích đoạn :
+ .AllowMultiSelect = True: .Show
For Each Item In .SelectedItems
FolItem = .InitialFileName
FItem = Replace(Item, FolItem, "")
CrtItem = Replace(FItem, ".xls", "")
With ThisWorkbook.Sheets("Tonghop")
With .Range(.[A2], .[A65536].End(xlUp)).Resize(, 21)
.AutoFilter 4, CrtItem
With Intersect(.Cells, .Offset(1, 4))
- Tôi chỉ mới tập tành học viết vài marco đơn giản thôi , sắn đây cũng là dịp học hỏi rất tốt cho bản thân ) .
Xin cảm ơn rất nhiều .

Bạn ơi, xin đừng bắt mình giải thích từng câu, từng chử trong code ---> Mình làm thì được mà giải thích cho người khác hiểu thi... Ẹc... Ẹc... chỉ sợ càng nói càng làm cho người khác.. tối mù
Chỉ xin nói vài điểm quan trọng trong code:
Application.FileDialog(1) dùng để mở 1 Dialog chọn file ---> Bạn sửa số 1 thành 1 con số khác thì có thể nó không phải là CHỌN FILE nữa (chọn thư mục chẳng hạn)

.AllowMultiSelect = True để cho phép ta chọn nhiều file cùng lúc (bằng cách dùng chuột kết hợp với phím Shift) ---> Điều này sẽ có lợi cho bạn khi các file con nằm cùng 1 thư mục, khi ấy ta chọn 1 lần tất cả các file là nó tổng hợp 1 lần luôn

FolItem = .InitialFileName lấy phần thư mục chưa file

FItem = Replace(Item, FolItem, "") chỉ lấy tên file (ví dụ 6A1.xls mà không có đường dẩn phía trước)

CrtItem = Replace(FItem, ".xls", "") lấy tên file không chứa đuôi xls (ví dụ 6A1) ---> Cái này dùng để làm điều kiện lọc cho AutoFilter

With ThisWorkbook.Sheets("Tonghop") ---> Ta phải chỉ định chính xác rằng ta muốn lọc mọi thứ về chính file đang chứa code ---> Nếu không, khi ta đứng tại 1 file khác rồi chạy code, nó ra tầm bậy ngay (nó sẽ trích về file ta đang đứng)

--------------------
Các mục còn lại thì đơn giản rồi ---> Bạn hãy tìm đọc thêm bài viết cơ bản về VBA của sư phụ SA_DQ: Chập chững đến VBA!
--------------------
Mình đã nghĩ ra tình huống sẽ tách các lớp ra từng file riêng... vì nếu làm bằng tay cũng rất cực khổ ---> Trong khi chờ đợi, bạn hãy tham khảo bài này
http://www.giaiphapexcel.com/forum/showthread.php?t=30293
Nó cũng trích từng lớp ra riêng đấy, có điều nó tách ra từng sheet chứ không phải từng file ---> vậy ta chỉ cần Move or copy ra New Workbook rồi Save lại là được rồi (Mình sẽ cố gắng hoàn thành code trong thời gian sớm nhất)

 

[ndu96081631]

Hoàn tất file cho bạn rồi đây!
Bạn mang file về, giải nén ra 1 thư mục ----> Sở dỉ phải đặt file Tonghop.xls vào 1 thư mục riêng vì sau đó bạn sẽ chia nhỏ các file con và chúng nằm cùng thư mục với file Tonghop, nếu để chung với file khác thì sẽ khó tìm kiếm
Tạm thời tôi đưa các file đã nhập điểm vào 1 thư mục riêng vì tránh bị chép đè sau đó
Bạn hãy thử nghiệm, nếu có trục trặc gì hãy thông báo nhé
Code của tôi như sau:
1> UDF hổ trợ

Private Function Unique(Range As Range)
  Dim Clls As Range
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each Clls In Range
      If Not IsEmpty(Clls) Then .Add Clls.Value, ""
    Next Clls
    Unique = .Keys
  End With
End Function

2> Code chính:

Sub ChiaFile()
  Dim MainWs As Worksheet, SubWs As Worksheet, Rng As Range, Item
  On Error GoTo Thoat
  Application.ScreenUpdating = False
  Set MainWs = ThisWorkbook.Sheets("Tonghop")
  Set Rng = MainWs.Range(MainWs.[A2], MainWs.[A65536].End(xlUp)).Resize(, 21)
  For Each Item In Unique(Intersect(Rng, Rng.Offset(1, 3)).Resize(, 1))
    With Workbooks.Add
      Set SubWs = .Sheets(1)
      SubWs.Name = Item
      Rng.AutoFilter 4, Item
      MainWs.Range(MainWs.Range("A1"), Rng).SpecialCells(12).Copy
      SubWs.Range("A1").PasteSpecial 8
      SubWs.Range("A1").PasteSpecial
      Rng.AutoFilter
      .Close True, ThisWorkbook.Path & "\" & Item & ".xls"
    End With
  Next
Thoat:
  Application.ScreenUpdating = True
End Sub

 

[letuongqt]

Sub ChiaFile()
Dim MainWs As Worksheet, SubWs As Worksheet, Rng As Range, Item
On Error GoTo Thoat
Application.ScreenUpdating = False
Set MainWs = ThisWorkbook.Sheets("Tonghop")
Set Rng = MainWs.Range(MainWs.[A2], MainWs.[A65536].End(xlUp)).Resize(, 21)
For Each Item In Unique(Intersect(Rng, Rng.Offset(1, 3)).Resize(, 1))
With Workbooks.Add
Set SubWs = .Sheets(1)
SubWs.Name = Item
Rng.AutoFilter 4, Item
MainWs.Range(MainWs.Range("A1"), Rng).SpecialCells(12).Copy
SubWs.Range("A1").PasteSpecial 8
SubWs.Range("A1").PasteSpecial
Rng.AutoFilter
.Close True, ThisWorkbook.Path & "\" & Item & ".xls"
End With
Next
Thoat:
Application.ScreenUpdating = True
End Sub[/php][/QUOTE]
Cho xin hỏi thêm : Phải thêm vào đoạn code trên như thế nào , để file trích ra vẫn giữ nguyên các ràng buộc được thiết lập trong (Kể cả cột chưa công thức nếu có ) data Validation có trong file ban đầu - Nếu thiết lập lại thì rất vất vã . Xin cảm ơn ndu96081631 rất nhiều .