Dò tìm theo mã để cập nhật dữ liệu (1 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 .

 

[ndu96081631]

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 .

Bạn vui lòng kiểm tra lại ---> Validation vẫn có trong các file con cơ mà

 

[letuongqt]

Bạn vui lòng kiểm tra lại ---> Validation vẫn có trong các file con cơ mà

Xin lỗi , tôi bị nhầm .
Đoạn code cập nhật và trích file của anh ndu96081631;205157] tôi lấy đưa vào file cụ thể của mình nhưng vẫn không cập nhật được (Copy đoạn code của anh và có sửa một số chỗ cho phù hợp) nhưng làm hoài nó vẫn không cập nhật được . Tôi gởi luôn lên đây , nhờ anh ndu96081631;205157] xem và giúp đỡ . anh cũng đừng phiền , rất cảm ơn rất nhiều .

 

[ndu96081631]

Xin lỗi , tôi bị nhầm .
Đoạn code cập nhật và trích file của anh ndu96081631;205157] tôi lấy đưa vào file cụ thể của mình nhưng vẫn không cập nhật được (Copy đoạn code của anh và có sửa một số chỗ cho phù hợp) nhưng làm hoài nó vẫn không cập nhật được . Tôi gởi luôn lên đây , nhờ anh ndu96081631;205157] xem và giúp đỡ . anh cũng đừng phiền , rất cảm ơn rất nhiều .

Ngay từ đâu bạn đưa file gốc này lên có phải đở vất vả không? File mới này cấu trúc hơi khác so với file bạn đưa lên lần trước nên code chạy không đúng là phải rồi!
Hỏi lại lần nữa cho chắc:
- Khi chia ra các file con, bạn muốn trích từ cột A đến cột nào? Cột Y chăng?
- Tôi vẫn chưa nắm rõ cột Z, AA và AB dùng để làm gì?
- Nếu dùng code mới trích file con thì code củ của bạn có bỏ được không? (tôi thấy code này đâu mấy cần thiết nhỉ?)
Xin nói lại 1 lần cho rõ

 

[letuongqt]

Hỏi lại lần nữa cho chắc:
- Khi chia ra các file con, bạn muốn trích từ cột A đến cột nào? Cột Y chăng?
- Tôi vẫn chưa nắm rõ cột Z, AA và AB dùng để làm gì?
- Nếu dùng code mới trích file con thì code củ của bạn có bỏ được không? (tôi thấy code này đâu mấy cần thiết nhỉ?)
Xin nói lại 1 lần cho rõ

Xin cảm ơn anh đa nhiệt tình giúp đỡ !: Anh có thể bỏ đoạn code có sẵn trong file gởi lên cũng được - kể cả các cột Z, AA ,... (Vì ban đầu tôi dự định dùng để lọc và dùng hàm đếm để thống kê điểm thi , xếp loại ).Tôi xin chốt lại như sau :
+ Ý tôi muốn trích đến cột Y .
+ Mỗi file con được trích ra cần trích thêm vùng thống kê nằm ngay cuối danh sách được trích (Mẫu bảng thống kê theo file đính kèm sau đây) .
Xin lỗi vì làm phiền anh khá nhiều , mong anh thông cảm . Xin rất cảm ơn .

 

[ndu96081631]

Xin cảm ơn anh đa nhiệt tình giúp đỡ !: Anh có thể bỏ đoạn code có sẵn trong file gởi lên cũng được - kể cả các cột Z, AA ,... (Vì ban đầu tôi dự định dùng để lọc và dùng hàm đếm để thống kê điểm thi , xếp loại ).Tôi xin chốt lại như sau :
+ Ý tôi muốn trích đến cột Y .
+ Mỗi file con được trích ra cần trích thêm vùng thống kê nằm ngay cuối danh sách được trích (Mẫu bảng thống kê theo file đính kèm sau đây) .
Xin lỗi vì làm phiền anh khá nhiều , mong anh thông cảm . Xin rất cảm ơn .

Làm lại lần nữa cho bạn đây! Thật ra cũng là code cũ nhưng sửa lại các tham chiếu của vùng dử liệu (vì nó khác với file ban đầu)
Bạn đặc biệt chú ý điểm này:
- Không được thay đổi vị trí vùng tiêu đề nằm tại A5 đến Y5 ---> Bất cứ động tác chèn dòng, chèn cột làm cho vị trí tiêu đề này thay đổi cũng sẽ dẩn đến code chạy không đúng
- Không được sửa tên sheet (hiện nó tên là TH) ---> Nếu bạn sửa tên sheet thì bắt buộc phải sửa luôn trong code (tìm chổ nào có chữ Sheets("TH") mà sửa)
- Vẫn như lần trước, các file con sẽ nằm cùng thư mục với file Tonghop.xls
- Sau khi nhập điểm, nên mang các file con cho vào 1 thư mục khác
- Không được tự ý sửa tên các file con (hiện tại nó lấy tên theo lớp)
-----------------------
Test lại 1 lần và thông báo cho tôi biết nếu có trục trặc nhé

 

[letuongqt]

Xin cảm ơn anh ndu96081631 .
Như vậy là đúng yêu cầu rồi anh ạ . Trong quá trình sử dụng nếu có vấn đề nào phát sinh tôi sẽ hỏi và rất mong được sự giúp đỡ của anh .
http://www.giaiphapexcel.com/forum/member.php?u=61139

 

[letuongqt]

Test lại 1 lần và thông báo cho tôi biết nếu có trục trặc nhé[/QUOTE]
Còn vấn đề khi mình Protecton file gốc (tonghop2) thì chạy marco chia file thì không được .
Anh ndu96081631 có thể giúp bổ sung thêm vấn đề này - Tức là theo yêu cầu : Khi protection file gốc (có 1 vài cột chứa công thức ) thì :
1/ Chia file được (bấm vào nút chia file ).
2/ Các file con sau khi đã chia cũng bị khóa những cell có chưa công thức tương ứng như file gốc .
Mong anh thông cảm cho , vấn đề này khi sử dụng mới phát hiện nhờ anh giúp đỡ tiếp nhé . Xin châmn thành cảm ơn .

 

[ndu96081631]

Test lại 1 lần và thông báo cho tôi biết nếu có trục trặc nhé

Còn vấn đề khi mình Protecton file gốc (tonghop2) thì chạy marco chia file thì không được .
Anh ndu96081631 có thể giúp bổ sung thêm vấn đề này - Tức là theo yêu cầu : Khi protection file gốc (có 1 vài cột chứa công thức ) thì :
1/ Chia file được (bấm vào nút chia file ).
2/ Các file con sau khi đã chia cũng bị khóa những cell có chưa công thức tương ứng như file gốc .
Mong anh thông cảm cho , vấn đề này khi sử dụng mới phát hiện nhờ anh giúp đỡ tiếp nhé . Xin châmn thành cảm ơn .[/QUOTE]
Cách đơn giản nhất: Trước khi chạy code hãy Unprotect sheet, chạy xong lại Protect trở lại
Đương nhiên bạn không phải làm bằng tay... Viết 1 đoạn code cho nó làm việc này
Hãy record macro để biết protect và unprotect code viết thế nào
Ví dụ cho đoạn này vào đầu code chính:
ActiveSheet.Unprotect 111
Và cho đoạn này vào cuối code chính
ActiveSheet.Protect 111
Trong đó 111 là password
Bạn tự làm đi ---> Quá dể!
--------------------
Ah... nhân đây nói thêm: Bạn vui lòng kiểm tra các file Excel trên máy tính của bạn... Máy bạn bị virus nặng rồi đấy!

 

[letuongqt]

Còn vấn đề khi mình Protecton file gốc (tonghop2) thì chạy marco chia file thì không được .
Anh ndu96081631 có thể giúp bổ sung thêm vấn đề này - Tức là theo yêu cầu : Khi protection file gốc (có 1 vài cột chứa công thức ) thì :
1/ Chia file được (bấm vào nút chia file ).
2/ Các file con sau khi đã chia cũng bị khóa những cell có chưa công thức tương ứng như file gốc .
Mong anh thông cảm cho , vấn đề này khi sử dụng mới phát hiện nhờ anh giúp đỡ tiếp nhé . Xin châmn thành cảm ơn .

Cách đơn giản nhất: Trước khi chạy code hãy Unprotect sheet, chạy xong lại Protect trở lại
Đương nhiên bạn không phải làm bằng tay... Viết 1 đoạn code cho nó làm việc này
Hãy record macro để biết protect và unprotect code viết thế nào
Ví dụ cho đoạn này vào đầu code chính:
ActiveSheet.Unprotect 111
Và cho đoạn này vào cuối code chính
ActiveSheet.Protect 111
Trong đó 111 là password
Bạn tự làm đi ---> Quá dể!
--------------------
Ah... nhân đây nói thêm: Bạn vui lòng kiểm tra các file Excel trên máy tính của bạn... Máy bạn bị virus nặng rồi đấy![/QUOT


Xin lỗi vì file bị virut: Ý tôi là các file con được trích ra vẫn còn protect (Nếu không thì tên học sinh , hoặc mã học sinh có thể bị thay đổi bởi người nhập liệu vào file con) . Đoạn code anh chỉ tôi đưa vào đầu và cuối sub chia file nó chỉ bảo vệ file gốc thối (Trong khi mình cần là các file con ) , anh vui lóng giúp nhé .

 

[letuongqt]

Ví dụ cho đoạn này vào đầu code chính:
ActiveSheet.Unprotect 111
Và cho đoạn này vào cuối code chính
ActiveSheet.Protect 111
Trong đó 111 là password

Sao đoạn code đưa vào sub chia file thì chỉ khóa được file nguồn (không khóa được file con khi chạy sub chia file) . Mục đích là các file con khi được trích ra phải tự động được khóa bảo vệ tương tự như ở file nguồn . Anh thông cảm chỉ cho .

 

[ndu96081631]

Ví dụ cho đoạn này vào đầu code chính:
ActiveSheet.Unprotect 111
Và cho đoạn này vào cuối code chính
ActiveSheet.Protect 111
Trong đó 111 là password

Sao đoạn code đưa vào sub chia file thì chỉ khóa được file nguồn (không khóa được file con khi chạy sub chia file) . Mục đích là các file con khi được trích ra phải tự động được khóa bảo vệ tương tự như ở file nguồn . Anh thông cảm chỉ cho .

Bạn để ý chổ này:

MainWs.Range(MainWs.UsedRange, MainWs.[A1]).SpecialCells(12).Copy
SubWs.Range("A1").PasteSpecial 8
SubWs.Range("A1").PasteSpecial

Là copy dử liệu từ file gốc, paste vào file con
MainWs là sheet của file gốc
SubWs là sheet của file con
Vậy chỉ cần:
- Bỏ chọn Locked cho tất cả các cell trong sheet SubWs
- Chọn Locked cho các cell có công thức trong sheet SubWs
- thêm Protect vào dưới nó là xong, chẳng hạn:

MainWs.Range(MainWs.UsedRange, MainWs.[A1]).SpecialCells(12).Copy
With SubWs
  .Range("A1").PasteSpecial 8
  .Range("A1").PasteSpecial
  .UsedRange.Locked = False
  .UsedRange.SpecialCells(3).Locked = True
  .Protect 111
End With

Thử xem thế nào nhé
(Mấy vụ protect rồ tiết này đúng là rách việc thật)

 

[letuongqt]

MainWs.Range(MainWs.UsedRange, MainWs.[A1]).SpecialCells(12).Copy
With SubWs
.Range("A1").PasteSpecial 8
.Range("A1").PasteSpecial
.UsedRange.Locked = False
.UsedRange.SpecialCells(3).Locked = True
.Protect 111
End With
[/php]Thử xem thế nào nhé


Đoạn code này khi đưa vào nó cứ báo lỗi ở dòng UsedRange.Locked = False không biết tại sao , đã thử nhiều lần nhưng không được .Tôi gởi file (File sạch , không nhiễm virut) lên xin anh thông cảm giúp cho ,
File tổng hợp và tất cả các file con khóa lại chỉ chừa lại (không khóa) vùng dữ liệu từ cột U--->E . Xin cảm ơn .

 

[ndu96081631]

MainWs.Range(MainWs.UsedRange, MainWs.[A1]).SpecialCells(12).Copy
With SubWs
.Range("A1").PasteSpecial 8
.Range("A1").PasteSpecial
.UsedRange.Locked = False
.UsedRange.SpecialCells(3).Locked = True
.Protect 111
End With
[/php]Thử xem thế nào nhé


Đoạn code này khi đưa vào nó cứ báo lỗi ở dòng UsedRange.Locked = False không biết tại sao , đã thử nhiều lần nhưng không được .Tôi gởi file (File sạch , không nhiễm virut) lên xin anh thông cảm giúp cho ,
File tổng hợp và tất cả các file con khóa lại chỉ chừa lại (không khóa) vùng dữ liệu từ cột U--->E . Xin cảm ơn .

Tôi thử nghiệm thấy có vấn đề gì đâu ta
Bạn kiểm tra lại file đính kèm này xem (có lẽ bạn đặt code không đúng vị trí)

 

[thang24]

Sợ thật! trình của bác ndu96081631 cao thật đấy.
cảm ơn bác vì bài này. Tôi Khai thác thêm được khá nhiều.

 

[lemanhha0276]

Thật sự tôi rất nể các sư phụ. Kính cẩn khấu đầu

 

[xmenx56]

Tôi thử nghiệm thấy có vấn đề gì đâu ta
Bạn kiểm tra lại file đính kèm này xem (có lẽ bạn đặt code không đúng vị trí)

Hình như file của em giống giống như bài 33. Nhưng vì không hiểu biết về VBA nên lực bất tòng tâm và Rất mong nhận được sự giúp đỡ từ ndu96081631 và của các bác trên diễn đàn. Chân thành cảm ơn rất nhiều.http://www.mediafire.com/?eq376917qhc38v8#1

 

[xmenx56]

Chẳng biết làm sao bài của em, không ai giải đáp, file của em có gì khó hiểu không hay là vấn đề gì.........Lần cuối cùng xin nhờ các bác ra tay giúp dùm. Chân thành cảm ơn.

 

[haiphusy]

Mình có 1 file như này, rất mong được các bạn làm giúp việc chia tách file này thành nhiều file theo dữ liệu của cột A

Rất cám ơn sự giúp đỡ của các bạn

 

[Huyen Le 1989]

Cảm ơn anh rất nhiều về file này. Anh cho em hỏi thêm, nếu em thêm 1 cột "đường dẫn" tương ứng với cột "Lớp" để khi xuất file thì mỗi file chạy về 1 đường dẫn khác nhau thì có được không? Và nếu được thì viết code thế nào? Cảm ơn anh!

 

[locbanh]

Cho e xin hỏi 1 chút,

Thứ Nhất là : E cũng down về làm thử nhưng nó chỉ chạy trên Module của chính File đó, e copy sang Module của PERSONAL.XLSB thì nó không có chạy. Tại sao vậy?

Thứ Hai là : + E cũng có chỉnh sửa 1 chút để giống với File của e , File "TongHop.xls" của A thì các A lấy cột D làm cột xuất ra file excel và cột tiêu đề tính từ cột A2 trở đi.
+ Dữ liệu của E thì tiêu đề từ cột A1 trở đi. lấy cột AF làm cột xuất ra file excel, nhưng sau khi chạy thì xuất ra thêm 1 file là file tiêu đề ( Vd: cột AF1 tên là Dem thì nó xuất ra thêm file "Dem.xls" )
Module , của e viết như sau :

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
---------------------------------------------------------------
Sub ChiaFileADD()
Dim MainWs As Worksheet, SubWs As Worksheet, Rng As Range, Item
On Error GoTo Thoat
Application.ScreenUpdating = False
Set MainWs = ThisWorkbook.Sheets("CP")
Set Rng = MainWs.Range(MainWs.[A2], MainWs.[A65536].End(xlUp)).Resize(, 32)
For Each Item In Unique(Intersect(Rng, Rng.Offset(, 31)).Resize(, 1))
With Workbooks.Add
Set SubWs = .Sheets(1)
SubWs.Name = Item
Rng.AutoFilter 32, 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

Mong Các A chỉ giùm, Thanks.