Mình có file DS hoc sinh.xls . Sheet1 là danh sách học sinh toàn khối . Mình muốn tự động cập nhật có điều kiện sang các sheet khác . Cụ thể : Em nào ở lớp 6/1 thì tự động cập nhật sang sheet 6/1 , Em nào ở lớp 6/2 thì tự động cập nhật sang sheet 6/2 .... nếu Sheet1 là danh sách học sinh toàn khối có chỉnh sửa thì các sheet kia cũng tự động cập nhật . Rất mong các bạn giúp đỡ , cám ơn rất nhiều !
có File đính kèm :
Mình có file DS hoc sinh.xls . Sheet1 là danh sách học sinh toàn khối . Mình muốn tự động cập nhật có điều kiện sang các sheet khác . Cụ thể : Em nào ở lớp 6/1 thì tự động cập nhật sang sheet 6/1 , Em nào ở lớp 6/2 thì tự động cập nhật sang sheet 6/2 .... nếu Sheet1 là danh sách học sinh toàn khối có chỉnh sửa thì các sheet kia cũng tự động cập nhật . Rất mong các bạn giúp đỡ , cám ơn rất nhiều !
có File đính kèm :
Cảm ơn bạn rất nhiều ! Nếu được bạn chỉ mình cách làm để mình làm cho khối khác chẳng hạn khối 7 , 8 ... Dựa vào đó mình đã làm cho khối khác nhưng không được . Rất mong bạn giúp đỡ .
Mình xem file bạn gởi , tới lớp 6/8 nó chạy xong thì thiếu mấy em , mình cũng không sửa được , bạn giúp mình với . Cảm ơn bạn rất nhiều !
Cảm ơn bạn rất nhiều ! Nếu được bạn chỉ mình cách làm để mình làm cho khối khác chẳng hạn khối 7 , 8 ... Dựa vào đó mình đã làm cho khối khác nhưng không được . Rất mong bạn giúp đỡ .
Mình xem file bạn gởi , tới lớp 6/8 nó chạy xong thì thiếu mấy em , mình cũng không sửa được , bạn giúp mình với . Cảm ơn bạn rất nhiều !
Mình đã chỉnh sửa lại cho đầy đủ rồi, bạn xem file đính kèm nha
+ Nếu bạn làm cho khối khác thì bạn cũng copy file này ra dùng cho khối khác (phải cùng cấu trúc dữ liệu) hoặc làm tiếp theo số liệu của khối khác liền kề ở phía bên dưới; muốn xem khối nào lớp nào thì chọn khối đó lớp đó
+ Nếu bạn muốn tìm hiểu thì bạn có thể bầm F3 -> Paste List hoặc vào insert->Name-> Define để xem công thức bạn nhé
Cám ơn bạn giao_nguyenthat rất nhiều , theo cách của bạn mình làm được rồi , mình rất thích cách của bạn , một lần nữa mình cám ơn bạn thật nhiều .
Có cách nào để nó tự động lọc ra mỗi lớp là mỗi sheet không bạn ? Vì cuối mỗi danh sách mình còn có nhiều cái tổng hợp khác nữa . Mình rất mong bạn giao_nguyenthat và các bạn khác giúp mình với .
Cám ơn bạn giao_nguyenthat rất nhiều , theo cách của bạn mình làm được rồi , mình rất thích cách của bạn , một lần nữa mình cám ơn bạn thật nhiều .
Có cách nào để nó tự động lọc ra mỗi lớp là mỗi sheet không bạn ? Vì cuối mỗi danh sách mình còn có nhiều cái tổng hợp khác nữa . Mình rất mong bạn giao_nguyenthat và các bạn khác giúp mình với .
Lọc danh sách sang từng sheet cũng đơn giản thôi, nhưng nếu sử dụng công thức thì trong bảng tính của bạn sẽ 'hơi bị nhiều" công thức, mình đề nghị một cách lọc bằng VBA, bạn nhập, hoặc sửa chữa, thêm bớt dữ liệu xong thì bấm cái nút nằm kế bên dữ liệu sẽ đưa về các sheet
Thân
Cách của bạn concogia đúng là cái mình cần , nhưng mình bấm nút nó không có chạy gì hết vậy bạn ? bạn xem lại dùm mình với .
Sẵn tiện bạn hướng dẫn mình cách làm một chút chút hoặc nếu mình có nhiều lớp hơn hay làm cho các khối khác thì phải làm sao . Bạn giúp mình với , mình rất mong tin .
Lọc danh sách sang từng sheet cũng đơn giản thôi, nhưng nếu sử dụng công thức thì trong bảng tính của bạn sẽ 'hơi bị nhiều" công thức, mình đề nghị một cách lọc bằng VBA, bạn nhập, hoặc sửa chữa, thêm bớt dữ liệu xong thì bấm cái nút nằm kế bên dữ liệu sẽ đưa về các sheet
Thân
Bây giờ mình không muốn tách theo lớp nữa mà muốn tách theo tên trường thì sửa code thế nào bạn, giúp mình nhé. ví dụ thay vì lớp 6/1, 6/2 .... (cột lớp trong ví dụ của bạn thanhtungpt1) của mình là trường: nghĩa hòa, tân thanh, hà bắc .... thì sửa code thế nào.
Mình không đưa được file đính kèm trong diễn đàn. bạn thông cảm nhé.
bạn tải file đính kèm của mính tại: http://www.mediafire.com/?0ais41kq11lt87u
Nếu được tên của các sheet mới trùng với tên trường ( có thể không dấu) thì tốt, còn nếu khó thì thôi cũng được miễn sao là tách được các trường ra các sheet khác.
Xin chân thành cảm ơn
Lọc danh sách sang từng sheet cũng đơn giản thôi, nhưng nếu sử dụng công thức thì trong bảng tính của bạn sẽ 'hơi bị nhiều" công thức, mình đề nghị một cách lọc bằng VBA, bạn nhập, hoặc sửa chữa, thêm bớt dữ liệu xong thì bấm cái nút nằm kế bên dữ liệu sẽ đưa về các sheet
Thân
Bác có thể lọc em học sinh theo lớp và sắp xếp thứ thự các em theo chỗ ở được không. Và thêm được tùy chọn ấp (chỗ ở) nào xếp trước, ấp nào xếp sau thì càng tuyệt.
đúng là cái mình cần , nhưng mình bấm nút nó không có chạy gì hết vậy bạn ? bạn xem lại dùm mình với .
Sẵn tiện bạn hướng dẫn mình cách làm một chút chút hoặc nếu mình có nhiều lớp hơn hay làm cho các khối khác thì phải làm sao . Bạn giúp mình với , mình rất mong tin .
Cách của CòGià vẫn có thể cải tiến được nữa; Ví dụ:
Ta lập ở đâu đó danh sách (DS) lớp duy nhất
Ta đưa DS này vô 1 Combo hay 1 Validition Lisst thế là khi ta chọn 1 từ DS lớp, ta sẽ có DS học sinh lớp đó ở trang tính Report
Khác với trường hợp trên là ta chỉ dùng 01 trang tính thay vì mỗi lớp 1 trang tính
Bạn xem trong file đính kèm (Tại [D1] của trang 'Loc') nếu thích mình sẽ tiếp tục hoàn chỉnh cho bạn)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [L2]) Is Nothing Then
Dim Sh As Worksheet
LocTruong
Set Sh = Sheets("Report")
Sh.[B4].CurrentRegion.Offset(1, 1).ClearContents
[ic1].CurrentRegion.Offset(1).Copy Destination:=Sh.[B5]
Sh.Select
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [L2]) Is Nothing Then
Dim Sh As Worksheet
LocTruong
Set Sh = Sheets("Report")
Sh.[B4].CurrentRegion.Offset(1, 1).ClearContents
[ic1].CurrentRegion.Offset(1).Copy Destination:=Sh.[B5]
Sh.Select
End If
End Sub
Cảm ơn bạn đã giúp mình, nhưng ý của mình là nếu có 10 trường thì tự tách thành 10 sheet khác nhau cơ không phải chọn như bạn ( để mính gửi về các trường mà). Bạn sửa giúp mình nhé.
Bạn tải file đính kèm của mính tại: http://www.mediafire.com/?0ais41kq11lt87u
nhưng ý của mình là nếu có 10 trường thì tự tách thành 10 sheet khác nhau cơ không phải chọn như bạn ( để mính gửi về các trường mà). Bạn sửa giúp mình nhé.
Mình sẽ hướng dẫn từ xa, bạn làm theo mình tuần tự như sau:
(*) Đến cột [iA] của trang 'Sum' & nhập như trong bảng sau:
Ma
|
HS trường
Voi|TT Vôi
DDuc|Dương Đức
TDinh|Tân Dĩnh
. . . |. . .
TLuc| Tiên Lục
(*) Tiếp theo bạn tạo ra các trang tính có tên như ở cột 'HZ' mà bạn vừa nhập;
(*) Bạn copy rieng cái macro này đè lên cái cũ của nó:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [l2]) Is Nothing Then
Dim Sh As Worksheet, ShName As String, sRng As Range
LocTruong
Set sRng = Range("IA1:IA99").Find([l2].Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then ShName = sRng.Offset(, -1).Value
Set Sh = Sheets(ShName)
Sh.[B4].CurrentRegion.Offset(1, 1).ClearContents
[ic1].CurrentRegion.Offset(1).Copy Destination:=Sh.[B5]
Sh.Select
End If
End Sub
Bạn sẽ thấy là nó chép đến trang biểu thị của trường đó, một khi bạn chọn trường trong [L2]
Những mong không fải gởi file đính kèm cho bạn & chúc thắng lợi.
Cảm ơn bạn! Mình đã làm được rồi, nhưng mình vẫn chưa ưng ý lắm vì ý của mình là: mới đầu mình chỉ có 1 sheet tổng hợp danh sách ( mình cũng không biết nó gồm bao nhiêu trường) mình muốn nó tự đếm xem trong danh sách có bao nhiêu trường và tách danh sách đó ra thành các sheet khác nhau theo tên trường "chỉ bằng 1 nút nhấn thôi" không phải chọn từng trường. Nghĩa là nó phải tự tạo số sheet bằng đúng số trường có trong danh sách. và nếu có thể thì đặt tên sheet theo tên trường hoặc là theo tên mặc định cũng được.
Mình làm được rồi, nhưng mình vẫn chưa ưng ý lắm vì ý của mình là: mới đầu mình chỉ có 1 sheet tổng hợp danh sách ( mình cũng không biết nó gồm bao nhiêu trường) mình muốn nó tự đếm xem trong danh sách có bao nhiêu trường và tách danh sách đó ra thành các sheet khác nhau theo tên trường "chỉ bằng 1 nút nhấn thôi" không phải chọn từng trường. Nghĩa là nó phải tự tạo số sheet bằng đúng số trường có trong danh sách. và nếu có thể thì đặt tên sheet theo tên trường hoặc là theo tên mặc định cũng được.
(1) Tạo danh sách duy nhất của cột tên Trường (từ 'E' sang 'IA') ;
Tên trang tính không nên có khoảng trắng hay tiếng Việt có dấu; Nên bạn fải chấp nhận tên các trang tính fát sinh sẽ là 2 hoặc 3 ký tự đầu của tên trường. (Chắc việc này sẽ fải nhờ hàm trợ giúp)
Hàm tự tạo này sẽ ghi vô cột 'HZ' các ký tự cần thiết đó;
(2) Tạo các trang tính theo danh sách có từ cột 'HZ' nêu trên;
(3) Tạo vòng lặp duyệt theo cột 'IA' để chép dữ liệu vô các trang hình thành.
Từng khâu mình nêu đã có trên diễn đàn; Việc tìm & gom lại thành kết quả là fần việc của bạn.
(Nếu chịu khó tìm sẽ ra, còn không thì hỏi & chịu khó nghe các câu lằm bằm thì xong thôi)
(1) Tạo danh sách duy nhất của cột tên Trường (từ 'E' sang 'IA') ;
Tên trang tính không nên có khoảng trắng hay tiếng Việt có dấu; Nên bạn fải chấp nhận tên các trang tính fát sinh sẽ là 2 hoặc 3 ký tự đầu của tên trường. (Chắc việc này sẽ fải nhờ hàm trợ giúp)
Hàm tự tạo này sẽ ghi vô cột 'HZ' các ký tự cần thiết đó;
(2) Tạo các trang tính theo danh sách có từ cột 'HZ' nêu trên;
(3) Tạo vòng lặp duyệt theo cột 'IA' để chép dữ liệu vô các trang hình thành.
Từng khâu mình nêu đã có trên diễn đàn; Việc tìm & gom lại thành kết quả là fần việc của bạn.
(Nếu chịu khó tìm sẽ ra, còn không thì hỏi & chịu khó nghe các câu lằm bằm thì xong thôi)
Cảm ơn bạn. nhưng mình bây giờ mới bắt đầu tiếp xúc với VBA nên bạn nói như vậy thì khó quá. Bạn có thể viết giúp mình để từ đó mình học hỏi dần không?
Cảm ơn bạn. nhưng mình bây giờ mới bắt đầu tiếp xúc với VBA nên bạn nói như vậy thì khó quá. Bạn có thể viết giúp mình để từ đó mình học hỏi dần không?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [l2]) Is Nothing Then
Dim Sh As Worksheet, ShName As String, sRng As Range
Columns("B:J").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"L1:L2"), CopyToRange:=Range("IC1:IK1"), Unique:=False
TaoSheets
Set sRng = Range("IA1:IA99").Find([l2].Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then ShName = sRng.Offset(, -1).Value
Set Sh = Sheets(ShName)
[B2].CurrentRegion.Copy Destination:=Sh.[A4]
Sh.[B4].CurrentRegion.Offset(1, 1).ClearContents
[ic1].CurrentRegion.Offset(1).Copy Destination:=Sh.[B5]
Sh.Range("A" & Sh.[B65500].End(xlUp).Row + 1).Resize(Sh.[A4]. _
CurrentRegion.Rows.Count).ClearContents
With Sh.[B2]
.Value = [HX1].Value & " " & [l2].Value
.Font.Bold = True: .Font.Size = 14
.Resize(, 8).Merge
End With
Sh.Select: Set Sh = Nothing
End If
End Sub
Mã:
[B]Sub TaoSheets()[/B]
Dim Cls As Range, Rng As Range
Set Rng = Range("HZ2:HZ" & [iA65500].End(xlUp).Row)
On Error Resume Next
For Each Cls In Rng
If SheetExist(Cls.Value) = False Then _
Sheets.Add.Name = Cls.Value
Next Cls
[B]End Sub[/B]
Cách của bạn concogia đúng là cái mình cần , nhưng mình bấm nút nó không có chạy gì hết vậy bạn ? bạn xem lại dùm mình với .
Sẵn tiện bạn hướng dẫn mình cách làm một chút chút hoặc nếu mình có nhiều lớp hơn hay làm cho các khối khác thì phải làm sao . Bạn giúp mình với , mình rất mong tin .
Có bạn nào làm ơn giúp mình với . Mình là thành viên mới , hàm và Vb mình chưa biết nhiều , những quy định về diễn đàn này mình cũng chưa biết nhiều , mài mò lắm mình mới tạo được trang này để nhờ mọi người giúp đỡ nhưng có bạn cũng vào đây để hỏi , đáp những vấn đề khác mà mình thì mù tịt , còn cái mình hỏi thì các bạn quên mất tiêu rồi . buồn quá sá buồn luôn . Có bạn nào biết giúp mình xem file bạn concogia sao nó không chạy vậy ? Sẵn tiện hướng dẫn mình cách làm một chút chút hoặc nếu mình có nhiều lớp hơn hay làm cho các khối khác thì phải làm sao . Các bạn giúp mình với , mình rất mong tin và cám ơn các bạn rất nhiều .
File bạn concogia gởi nè mình bấm nút nhưng nó không chạy :
Có bạn nào làm ơn giúp mình với . Mình là thành viên mới , hàm và Vb mình chưa biết nhiều , những quy định về diễn đàn này mình cũng chưa biết nhiều , mài mò lắm mình mới tạo được trang này để nhờ mọi người giúp đỡ nhưng có bạn cũng vào đây để hỏi , đáp những vấn đề khác mà mình thì mù tịt . Có bạn nào biết giúp mình xem file bạn concogia sao nó không chạy . Sẵn tiện hướng dẫn mình cách làm một chút chút hoặc nếu mình có nhiều lớp hơn hay làm cho các khối khác thì phải làm sao . Các bạn giúp mình với , mình rất mong tin và cám ơn các bạn rất nhiều .
File bạn concogia gởi :
Minh chạy đ­uoc mà. bạn xem lại chế độ bảo vê. vào Tools/macro/succurity/chọn low­­­­­­­­­­­­ ­­­­­­­
Có bạn nào làm ơn giúp mình với . Mình là thành viên mới , hàm và Vb mình chưa biết nhiều , những quy định về diễn đàn này mình cũng chưa biết nhiều , mài mò lắm mình mới tạo được trang này để nhờ mọi người giúp đỡ nhưng có bạn cũng vào đây để hỏi , đáp những vấn đề khác mà mình thì mù tịt , còn cái mình hỏi thì các bạn quên mất tiêu rồi . buồn quá sá buồn luôn . Có bạn nào biết giúp mình xem file bạn concogia sao nó không chạy vậy ? Sẵn tiện hướng dẫn mình cách làm một chút chút hoặc nếu mình có nhiều lớp hơn hay làm cho các khối khác thì phải làm sao . Các bạn giúp mình với , mình rất mong tin và cám ơn các bạn rất nhiều .
File bạn concogia gởi nè mình bấm nút nhưng nó không chạy :
Híc, mình rất thông cảm với bạn, thế này nhé:
1- Bạn cứ làm theo hướng dẫn của bạn viehoai thì file đó sẽ chạy thôi
2- Nếu bạn có nhiều lớp hơn thì sửa lại tí trong code, trong bài số lớp của bạn là 8 nên code For i= 1 to 8 nếu "bi" giờ số lớp của bạn (thí dụ) là 15 thì sửa thành For i = 1 to 15
Mã:
Dim Ws As Worksheet, i, J As Integer
For J = 1 To 8
Set Ws = Sheets("6." & J)
........
3- Làm cho các khối khác: điều kiện bắt buộc là cấu trúc bảng phải giống nhau, chỉ khác danh sách, tên lớp ( 6/1 ==> 7/1, 8/1.....) tên sheet (6.1==> 7.1, 7.2, 8.1, .....)
Mã:
With Range([a1], [a1000].End(xlUp)).Resize(, 15)
.AutoFilter Field:=15, Criteria1:="6/" & J
.SpecialCells(xlCellTypeVisible).Copy Ws.[A7]
.AutoFilter
End With
Bạn sửa chỗ này: .AutoFilter Field:=15, Criteria1:="6/" & J số 6 thành 7 hoặc 8, 9
Mong bạn thành công
Cuối cùng, nếu bạn không sửa được thì gởi hết lên đi mình làm giúp cho
Thân
Thì ra là vậy , nó chạy rồi , mình rất thích . cám ơn bạn viehoai rất nhiều !
Nhưng các bạn ơi ! Mình nhập thêm lớp nữa 6/9 , 7/1 , 8/2 ... thì nó không chạy những lớp đó . Vậy các bạn giúp mình làm cho nó chạy ra hết luôn , nhập mấy lớp thì nó tự động tạo ra mấy lớp nhe các bạn . Mình đang rất cần , đang rất mong tin . Mình cám ơn các bạn thật nhiều !
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [l2]) Is Nothing Then
Dim Sh As Worksheet, ShName As String, sRng As Range
Columns("B:J").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"L1:L2"), CopyToRange:=Range("IC1:IK1"), Unique:=False
TaoSheets
Set sRng = Range("IA1:IA99").Find([l2].Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then ShName = sRng.Offset(, -1).Value
Set Sh = Sheets(ShName)
[B2].CurrentRegion.Copy Destination:=Sh.[A4]
Sh.[B4].CurrentRegion.Offset(1, 1).ClearContents
[ic1].CurrentRegion.Offset(1).Copy Destination:=Sh.[B5]
Sh.Range("A" & Sh.[B65500].End(xlUp).Row + 1).Resize(Sh.[A4]. _
CurrentRegion.Rows.Count).ClearContents
With Sh.[B2]
.Value = [HX1].Value & " " & [l2].Value
.Font.Bold = True: .Font.Size = 14
.Resize(, 8).Merge
End With
Sh.Select: Set Sh = Nothing
End If
End Sub
Mã:
[B]Sub TaoSheets()[/B]
Dim Cls As Range, Rng As Range
Set Rng = Range("HZ2:HZ" & [iA65500].End(xlUp).Row)
On Error Resume Next
For Each Cls In Rng
If SheetExist(Cls.Value) = False Then
Sheets.Add.Name = Cls.Value
Next Cls
[B]End Sub[/B]
Bạn làm như vậy thật đúng ý của mình!
Xin chân thành cảm ơn các bạn, Mình nhờ bạn chỉnh lại giúp mình một chút nữa đó là khi các sheet mới được tạo thành nó không được định dạng vừa với dữ liệu trong ô, do vậy mình lại phải mất công chỉnh từng sheet một rất mất thời gian, bạn thêm cho mình đoạn code tự động căn chỉnh dữ liệu vào để sau khi dừ liệu được coppy tới sheet mới nó tự động căn chỉnh vừa với dữ liệu trong ô đó.
Tiện thể bạn cho mình hỏi bạn tạo chỗ : có phải là sử dụng validation để tạo không, hướng dẫn mình với ( mình mới bắt đầu học excel bạn thông cảm) để mình thực thành trên một file khác nhé. Xin cảm ơn.
Mình hỏi thêm chút: Làm như bạn thì mình vẫn phải biết trong danh sách của mình gồm những trường nào phải không. Mình thấy bạn có chỗ: để ghi tên các trường có trong danh sách? "Bạn đừng giận nhé mình hỏi hơi nhiều nhỉ?""Đang học mà"? " Mình cũng rất thích học sinh của mình hỏi nhiều đấy" hihi
Híc, mình rất thông cảm với bạn, thế này nhé:
1- Bạn cứ làm theo hướng dẫn của bạn viehoai thì file đó sẽ chạy thôi
2- Nếu bạn có nhiều lớp hơn thì sửa lại tí trong code, trong bài số lớp của bạn là 8 nên code For i= 1 to 8 nếu "bi" giờ số lớp của bạn (thí dụ) là 15 thì sửa thành For i = 1 to 15
Mã:
Dim Ws As Worksheet, i, J As Integer
For J = 1 To 8
Set Ws = Sheets("6." & J)
........
3- Làm cho các khối khác: điều kiện bắt buộc là cấu trúc bảng phải giống nhau, chỉ khác danh sách, tên lớp ( 6/1 ==> 7/1, 8/1.....) tên sheet (6.1==> 7.1, 7.2, 8.1, .....)
Mã:
With Range([a1], [a1000].End(xlUp)).Resize(, 15)
.AutoFilter Field:=15, Criteria1:="6/" & J
.SpecialCells(xlCellTypeVisible).Copy Ws.[A7]
.AutoFilter
End With
Bạn sửa chỗ này: .AutoFilter Field:=15, Criteria1:="6/" & J số 6 thành 7 hoặc 8, 9
Mong bạn thành công
Cuối cùng, nếu bạn không sửa được thì gởi hết lên đi mình làm giúp cho
Thân
Mình cám ơn bạn concogia rất nhiều ! Về tăng thêm lớp 6 mình làm được rối , còn khối lớp 7 , 8 , 9 : có phải là muốn làm khối khác mình phải copy thành file khác rồi mới sửa số 6 thành số 7 hay 8 ... không bạn ? Nếu như vậy mình thấy cũng được nhưng hơi bất tiện vì mình có vài cái tổng hợp ở cuối danh dách mỗi lớp và cả tổng hợp toàn trường nữa . Bạn có cách nào làm cho nó chạy ra hết luôn , nhập mấy lớp thì nó chạy ra mấy lớp luôn nha bạn .
Bạn làm như vậy thật đúng ý của mình!
Mình nhờ bạn chỉnh lại giúp mình một chút nữa đó là (3) khi các sheet mới được tạo thành nó không được định dạng vừa với dữ liệu trong ô, do vậy mình lại phải mất công chỉnh từng sheet một rất mất thời gian, bạn thêm cho mình đoạn code tự động căn chỉnh dữ liệu vào để sau khi dừ liệu được coppy tới sheet mới nó tự động căn chỉnh vừa với dữ liệu trong ô đó.
Tiện thể bạn cho mình hỏi bạn tạo chỗ :(1)View attachment 49682có phải là sử dụng validation để tạo không, hướng dẫn mình với ( mình mới bắt đầu học excel bạn thông cảm) để mình thực thành trên một file khác nhé. Xin cảm ơn.
Mình hỏi thêm chút: (2) Làm như bạn thì mình vẫn phải biết trong danh sách của mình gồm những trường nào phải không. Mình thấy bạn có chỗ: View attachment 49683 để ghi tên các trường có trong danh sách? "Bạn đừng giận nhé mình hỏi hơi nhiều nhỉ?""Đang học mà"? " Mình cũng rất thích học sinh của mình hỏi nhiều đấy" hihi
(1) Fải đó bạn; Bạn bấm chọn ô đó & vô menu Data -> Validation sẽ biết ngay mà.
(2) Trong file mình có tằng bạn 1 macro này:
PHP:
Sub DSTruong()
Sheets("Sum").Select
Columns("E:E").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"IA1"), Unique:=True
End Sub
Nò sẽ tạo ra danh sách các trường duy nhất mà bạn đã thấy tại cột 'IA'.
(Cần nói thêm rằng cột trái liền kề cũng dùng để tạo tên các trang tính đó nha.
Nếu muốn nghiên cứu sâu thêm, bạn cần xem hàm tự tạo để tạo ra cột 'HZ' này)
(3) Mình chưa biết bạn định dạng trang tính mới sẽ như thế nào. Lẽ đó mình chỉ có thể đề nghị bạn thêm vô dòng lệnh sau dòng End With câu lệnh sau:
PHP:
Sh.Columns("A:J").EntireColumn.AutoFit
(Bạn thêm vô macro có trong trang 'Sum' đó nha.)
Nếu muốn định dạng khác, bạn fải đưa mẫu lên
Chúc thành công!
Mình cám ơn bạn concogia rất nhiều ! Về tăng thêm lớp 6 mình làm được rối , còn khối lớp 7 , 8 , 9 : có phải là muốn làm khối khác mình phải copy thành file khác rồi mới sửa số 6 thành số 7 hay 8 ... không bạn ? Nếu như vậy mình thấy cũng được nhưng hơi bất tiện vì mình có vài cái tổng hợp ở cuối danh dách mỗi lớp và cả tổng hợp toàn trường nữa . Bạn có cách nào làm cho nó chạy ra hết luôn , nhập mấy lớp thì nó chạy ra mấy lớp luôn nha bạn .
Không nhất thiết phải như vậy đâu bạn, nếu ý bạn muốn thiết kế dữ liệu như vậy mình đề nghị 2 cách:
Thí dụ trường bạn 4 khối có 45 lớp , bạn tạo 45 sheet cho các lớp ( 6.1, 6.2.....7.5, 7.6.....9.4..vv)
1- Một sheet chứa danh sách toàn trường, tạo 4 nút ( khối 6, 7, 8, 9) trên sheet đó , muốn đưa về khối nào thì chọn nút về khối đó
2- Tạo 4 sheet (KHOI 6, KHOI 7 ...) muốn đưa danh sách về khối nào thì chọn khối tương ứng
Tất cả dữ liệu nằm chung trong 1 file, cấu trúc dữ liệu trong các sheet đồng nhất rất thuận tiện cho bạn thống kê các loại trên đời
Hy vọng bạn tạo được bảng dữ liệu như ý
Không nhất thiết phải như vậy đâu bạn, nếu ý bạn muốn thiết kế dữ liệu như vậy mình đề nghị 2 cách:
Thí dụ trường bạn 4 khối có 45 lớp , bạn tạo 45 sheet cho các lớp ( 6.1, 6.2.....7.5, 7.6.....9.4..vv)
1- Một sheet chứa danh sách toàn trường, tạo 4 nút ( khối 6, 7, 8, 9) trên sheet đó , muốn đưa về khối nào thì chọn nút về khối đó
2- Tạo 4 sheet (KHOI 6, KHOI 7 ...) muốn đưa danh sách về khối nào thì chọn khối tương ứng
Tất cả dữ liệu nằm chung trong 1 file, cấu trúc dữ liệu trong các sheet đồng nhất rất thuận tiện cho bạn thống kê các loại trên đời
Hy vọng bạn tạo được bảng dữ liệu như ý
Cám ơn bạn concogia ! Mình thích cách làm một sheet chứa danh sách toàn trường, tạo 4 nút ( khối 6, 7, 8, 9) trên sheet đó , muốn đưa về khối nào thì chọn nút về khối đó . Nhưng mình chưa biết làm 4 cái nút , bạn hướng dẫn mình một chút chút về cách làm cái nút với . Bạn làm mẫu cho mình , mình gởi file cho bạn , bạn làm dùm mình nha . mình cám ơn bạn thật nhiều !
Không nhất thiết phải như vậy đâu bạn, nếu ý bạn muốn thiết kế dữ liệu như vậy mình đề nghị 2 cách:
Thí dụ trường bạn 4 khối có 45 lớp , bạn tạo 45 sheet cho các lớp ( 6.1, 6.2.....7.5, 7.6.....9.4..vv)
1- Một sheet chứa danh sách toàn trường, tạo 4 nút ( khối 6, 7, 8, 9) trên sheet đó , muốn đưa về khối nào thì chọn nút về khối đó
2- Tạo 4 sheet (KHOI 6, KHOI 7 ...) muốn đưa danh sách về khối nào thì chọn khối tương ứng
Tất cả dữ liệu nằm chung trong 1 file, cấu trúc dữ liệu trong các sheet đồng nhất rất thuận tiện cho bạn thống kê các loại trên đời
Hy vọng bạn tạo được bảng dữ liệu như ý[/QUOTE
Cám ơn bạn concogia ! Mình thích cách làm một sheet chứa danh sách toàn trường, tạo 4 nút ( khối 6, 7, 8, 9) trên sheet đó , muốn đưa về khối nào thì chọn nút về khối đó . Nhưng mình chưa biết làm 4 cái nút , bạn hướng dẫn mình một chút chút về cách làm cái nút với . Bạn làm mẫu cho mình , mình gởi file cho bạn , bạn làm dùm mình nha . mình cám ơn bạn thật nhiều !
Bạn thử lại nhé, mình chưa xem kỹ lại đâu
Cách tạo nút:
View ==> Toolbars ==> Control Toolbox
Khi thanh công cụ hiện lên bạn thò "anh tý" vào hình cái nút bấm chọn, thò vào bảng tính vẽ cái nút, double click chép code vào là ...xong
Mình có file Ap.xls yêu cầu như bạn thanhtungpt1 , mình đã xử lý theo công thức này nhưng nó chạy không đủ theo yêu cầu lọc.(Dữ liệu chỉ có ở sheet DL và 6T).
Đây là file mình gửi kèm, nhờ bạn giao_nguyenthat sửa công thức dùm , mình cần lắm.Cảm ơn trước!
Bạn thử lại nhé, mình chưa xem kỹ lại đâu
Cách tạo nút:
View ==> Toolbars ==> Control Toolbox
Khi thanh công cụ hiện lên bạn thò "anh tý" vào hình cái nút bấm chọn, thò vào bảng tính vẽ cái nút, double click chép code vào là ...xong
Mình có file Ap.xls yêu cầu như bạn thanhtungpt1 , mình đã xử lý theo công thức này nhưng nó chạy không đủ theo yêu cầu lọc.(Dữ liệu chỉ có ở sheet DL và 6T).
Đây là file mình gửi kèm, nhờ bạn giao_nguyenthat sửa công thức dùm , mình cần lắm.Cảm ơn trước!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [c1]) Is Nothing Then
Dim Sh As Worksheet, Rng As Range, sRng As Range, Sht As Worksheet
Dim ShName As String, MyAdd As String
Dim Col As Byte, eRw As Long
Set Rng = Range([c2], [C28]): Set Sh = Sheets("DL")
eRw = Sh.[c65500].End(xlUp).Row
Set sRng = Rng.Find([c1].Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then Set Sht = Sheets(sRng.Offset(, -2).Value)
Set Rng = Sh.Range(Sh.[e4], Sh.[E65500].End(xlUp))
Col = Sh.[e4].CurrentRegion.Columns.Count
Sht.[b5].Resize(eRw, Col).ClearContents
Set sRng = Rng.Find([c1].Value)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
With Sht.[B65500].End(xlUp).Offset(1).Resize(, Col)
.Value = Sh.Cells(sRng.Row, "B").Resize(, Col).Value
End With
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
End If
Sht.Select: Set Sht = Nothing
End Sub
Hướng dẫn sử dụng:
(*) Bạn đến trang tính 'Main' & chọn 1 trong các năm tại [C1]
(*) Ngay sau đó bạn sẽ được đưa tới trang tính có dữ liệu được chép từ 'DL' sang đầy đủ.
Đáng lẽ bạn hướng dẫn cụ thể 1 chút thì khi làm xong đỡ sửa đi sửa lại.
-Tạo va chép thành các sheet theo độ tuổi? Trong dữ liệu có cả 1 tuổi trở lên, vậy báo cáo từ độ tuổi nào?
-Kết quả là toàn bộ các cột hay chỉ có 1 số cột nào đó? (Nếu có mẫu báo cáo thì tiện nhất)
-KHi dùng xong thì xóa toàn bộ các sheet báo cáo cho nhẹ file. Khi cần nhấn nút thì lại có?
-Những sheet nào bắt buộc có và cái nào có thể xóa?
Thấy bác Sealand giúp mọi người nhiệt tình quá. Mình cũng xin nhờ ké chút.
Mình có một file và các sheet. muốn tổng hợp lên một sheet nhưng theo 2 điện kiện. cụ thể như trong file kèm theo
Bác Sealand giúp nhiệt tình quá. Mình xin nhờ ké chút.
Mình có một file và các sheet. muốn tổng hợp lên một sheet nhưng theo 2 điện kiện. cụ thể như trong file kèm theo
Option Explicit
Sub CapNhatDuLieu()
Dim Rng As Range, sRng As Range, Rng0 As Range
Dim Sh, Dat As Date
Dim ProductName As String, MyAdd As String
If Selection.Value = "" Then Exit Sub
Set Rng = Selection.EntireRow: Dat = [A3].Value
Set sRng = Rng.Find("TOTAL", , xlFormulas, xlPart)
If Not sRng Is Nothing Then
ProductName = sRng.End(xlUp).Value
Set Rng0 = Cells(sRng.Row, "D").Resize(, 9)
Else
ProductName = Cells(Rng.Row, "C").Value
Set Rng = Cells(Rng.Row, "C").Resize(99)
Set sRng = Rng.Find("TOTAL")
If Not sRng Is Nothing Then Set Rng0 = Cells(sRng.Row, "D").Resize(9)
End If
Set Sh = Sheets("SUMMARY")
Set Rng = Sh.Range(Sh.[A4], Sh.[A65500].End(xlUp))
Set sRng = Rng.Find(ProductName, , , xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
If Month(sRng.Offset(, 1).Value) = Month(Dat) Then
Cells(sRng.Row, "C").Resize(, 9).Value = 0
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
End Sub
Cách dùng:
(Mình đã gán fím tắc cho macro này tổ hợp {CTRL}+{SHIFT}+C)
Sau khi sửa số liệu hay nhập mới (Trong trường hợp nhập mới đã fải có dòng TOTAL . . ." ở cột 'C') & con trỏ chuột đang trên dòng nào đó có dữ liệu cần cập nhật vô trang 'Summary', ta bấm tổ hợp fím để macro cập nhất số liệu sang 'Summary' cho bạn. (Tất nhiên ô kích hoạt fải là ô đang chứa dữ liệu)
Ví dụ (1) ta cần sửa dữ liệu tại [D19] của 'MAY' thành 90; Sau khi sửa & {ENTER} xong (Trỏ chuột có thể đang ở [D20]) ta bấm tổ hợp fím nóng nêu trên & sang trang 'Summary' để xem kết quả.
VD2 tại trang 'JUL' ta nhập dữ liệu vài dòng vô sau các dòng 4 & nhập công thức tổng ở dòng 27. Sau đó để trỏ chuột trên 1 ô trong vùng từ 'D27:L27' có dữ liệu & bấm tổ hợp fím thân thương.
Có 2 vấn đề với câu hỏi của bạn:
1/Giải quyết vấn đề cụ thể của bài: Mình viết 2 hàm rất nhỏ để giải quyết vấn đề này. Nhưng khó khăn là bạn dùng tên làm tiêu chuẩn trong khi tên rất dài tiềm ẩn sai sót làm các hàm tìm kiếm và tổng hợp theo điều kiện bị sai lệch. Ví dụ: Đố bạn 2 tên này có gì khác nhau: Fork R Gear Shift ( 24211 - KPH - 9001) và Fork R Gear Shift ( 24211 - KPH - 9001)
Do vậy, khi nhập nên dùng validation , Combobox hay chép dán chứ gõ trực tiếp e không ổn cho việc thống kê, kể cả các hàm trong 1 sheet. Mình tranh thủ viết đêm nên chưa soát hết được, bạn kiểm tra chỗ sao sai thì chắc là tên đó bị sai và dùng copy rồi paste vào thay thế tất cả các ô tên đó trên sheet tháng và sheet tổng hợp.
Hàm 1: Mình đổi CodeName các sheet tháng thành Tn. Ví dụ Sheet "Jan" thành T1
Mã:
Function Look(ByVal ch, cl1, cl2 As String, m As Date) As Double
Dim sh As Worksheet, i
Dim c As Range
Set sh = Choose(Month(m), T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, T12)
With sh.Range(cl1 & "1:" & cl1 & "500")
Set c = .Find(ch, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not c Is Nothing Then
Look = sh.Cells(c.Row, cl2)
Else
Look = 0
End If
End With
End Function
Cú pháp =Look(TenSP,Cot_ten,Cot_tim,Thang_tim)
Hàm 2: Hàm Sumif cải biên:
Mã:
Function LookSum(ByVal ch As String, cl As String, m As Date) As Double
Dim sh As Worksheet, i
Set sh = Choose(Month(m), T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, T12)
i = sh.[b65536].End(xlUp).Row
LookSum = WorksheetFunction.SumIf(sh.Range("C5:C" & i), "=" & ch, sh.Range(cl & "5:" & cl & i))
End Function
Cú pháp: =LookSum(Ten,Cot_tien,Thang)
Lưu ý trong các hàm này cột là ký tự cột. ví dụ cột D nhập "D"
2/Bạn nên cải tiến File không nhập thế này mà nhập chung 1 sheet DATA sau đó sử lý các báo cáo. Nen bổ xung cột Mã SP để việc tổng hợp và sử lý dữ liệu chính xác nhất.
Bạn thử lại nhé, mình chưa xem kỹ lại đâu
Cách tạo nút:
View ==> Toolbars ==> Control Toolbox
Khi thanh công cụ hiện lên bạn thò "anh tý" vào hình cái nút bấm chọn, thò vào bảng tính vẽ cái nút, double click chép code vào là ...xong
Bạn concogia ơi ! Mình làm thử thì nó chạy ngon lắm , nhưng mình làm thiệt thì lúc đầu nó cũng chạy tốt , đến lúc gần xong thì nó báo lỗi tùm lum . Thôi mình gởi file nhờ bạn chỉnh giùm mình với nha . Nhờ bạn thêm dùm code hai cái nút DS CHUYEN ĐI và nút DS BO HOC để mình lọc qua 2 sheet CHUYEN DI và BO HOC . Còn ở các sheet từng lớp nếu có thể bạn bỏ dùm mình cột lớp nha bạn vì DS từng lớp nên mình muốn ghi phía trên tiêu đề . Bạn làm ơn giúp mình với , mình cám ơn bạn rất nhiều .
Bạn concogia ơi ! Mình làm thử thì nó chạy ngon lắm , nhưng mình làm thiệt thì lúc đầu nó cũng chạy tốt , đến lúc gần xong thì nó báo lỗi tùm lum . Thôi mình gởi file nhờ bạn chỉnh giùm mình với nha . Nhờ bạn thêm dùm code hai cái nút DS CHUYEN ĐI và nút DS BO HOC để mình lọc qua 2 sheet CHUYEN DI và BO HOC . Còn ở các sheet từng lớp nếu có thể bạn bỏ dùm mình cột lớp nha bạn vì DS từng lớp nên mình muốn ghi phía trên tiêu đề . Bạn làm ơn giúp mình với , mình cám ơn bạn rất nhiều .
Khi copy code vào các nút bạn copy dư cái này: Option Explicit ở trên đầu, xóa mấy em đó đi là ổn
Đây là code khối 1 (thêm phần xóa cột lớp)
Mã:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Ws As Worksheet, i, J As Integer
For J = 1 To 6
Set Ws = Sheets("1." & J)
Ws.Range(Ws.[A4], Ws.[O4].End(xlDown)).Clear
With Range([a1], [a1000].End(xlUp)).Resize(, 15)
.AutoFilter Field:=15, Criteria1:="1/" & J
.SpecialCells(xlCellTypeVisible).Copy Ws.[A4]
.AutoFilter
End With
Ws.[O:O].Delete
For i = 1 To Ws.Range(Ws.[B5], Ws.[B5].End(xlDown)).Rows.Count
Ws.Cells(i + 4, 1) = i
Next
Next
Application.ScreenUpdating = True
End Sub
Chú ý khi copy chỉ cần copy từ Application....thôi nhé
Tạo nút BOHOC, them sheet mới tên BOHOC, chép cái này vào nút BOHOC
Mã:
Private Sub CommandButton9_Click()
Application.ScreenUpdating = False
Dim Ws As Worksheet, i As Integer
Set Ws = Sheets("BOHOC")
Ws.Range(Ws.[A4], Ws.[O4].End(xlDown)).Clear
With Range([a1], [a1000].End(xlUp)).Resize(, 15)
.AutoFilter Field:=15, Criteria1:="BH"
.SpecialCells(xlCellTypeVisible).Copy Ws.[A4]
.AutoFilter
End With
For i = 1 To Ws.Range(Ws.[B5], Ws.[B5].End(xlDown)).Rows.Count
Ws.Cells(i + 4, 1) = i
Next
Application.ScreenUpdating = True
End Sub
Tương tự như thế khi bạn tạo nút và sheet học sinh chuyển đi ( bạn sửa: Set Ws = Sheets("BOHOC") thành Set Ws = Sheets("DI") & Criteria1:="BH" thành Criteria1:="DI" nhé)
Híc, chúc bạn làm lại ngon cơm (làm nhiều lần mới nhớ nhiều)
Có 2 vấn đề với câu hỏi của bạn:
1/Giải quyết vấn đề cụ thể của bài: Mình viết 2 hàm rất nhỏ để giải quyết vấn đề này. Nhưng khó khăn là bạn dùng tên làm tiêu chuẩn trong khi tên rất dài tiềm ẩn sai sót làm các hàm tìm kiếm và tổng hợp theo điều kiện bị sai lệch. Ví dụ: Đố bạn 2 tên này có gì khác nhau: Fork R Gear Shift ( 24211 - KPH - 9001) và Fork R Gear Shift ( 24211 - KPH - 9001)
Do vậy, khi nhập nên dùng validation , Combobox hay chép dán chứ gõ trực tiếp e không ổn cho việc thống kê, kể cả các hàm trong 1 sheet. Mình tranh thủ viết đêm nên chưa soát hết được, bạn kiểm tra chỗ sao sai thì chắc là tên đó bị sai và dùng copy rồi paste vào thay thế tất cả các ô tên đó trên sheet tháng và sheet tổng hợp.
Hàm 1: Mình đổi CodeName các sheet tháng thành Tn. Ví dụ Sheet "Jan" thành T1
Mã:
Function Look(ByVal ch, cl1, cl2 As String, m As Date) As Double
Dim sh As Worksheet, i
Dim c As Range
Set sh = Choose(Month(m), T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, T12)
With sh.Range(cl1 & "1:" & cl1 & "500")
Set c = .Find(ch, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not c Is Nothing Then
Look = sh.Cells(c.Row, cl2)
Else
Look = 0
End If
End With
End Function
Cú pháp =Look(TenSP,Cot_ten,Cot_tim,Thang_tim)
Hàm 2: Hàm Sumif cải biên:
Mã:
Function LookSum(ByVal ch As String, cl As String, m As Date) As Double
Dim sh As Worksheet, i
Set sh = Choose(Month(m), T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, T12)
i = sh.[b65536].End(xlUp).Row
LookSum = WorksheetFunction.SumIf(sh.Range("C5:C" & i), "=" & ch, sh.Range(cl & "5:" & cl & i))
End Function
Cú pháp: =LookSum(Ten,Cot_tien,Thang)
Lưu ý trong các hàm này cột là ký tự cột. ví dụ cột D nhập "D"
2/Bạn nên cải tiến File không nhập thế này mà nhập chung 1 sheet DATA sau đó sử lý các báo cáo. Nen bổ xung cột Mã SP để việc tổng hợp và sử lý dữ liệu chính xác nhất.
mình có file ds hoc sinh.xls . Sheet1 là danh sách học sinh toàn khối . Mình muốn tự động cập nhật có điều kiện sang các sheet khác . Cụ thể : Em nào ở lớp 6/1 thì tự động cập nhật sang sheet 6/1 , em nào ở lớp 6/2 thì tự động cập nhật sang sheet 6/2 .... Nếu sheet1 là danh sách học sinh toàn khối có chỉnh sửa thì các sheet kia cũng tự động cập nhật . Rất mong các bạn giúp đỡ , cám ơn rất nhiều !
Có file đính kèm :
Có 2 vấn đề với câu hỏi của bạn:
1/Giải quyết vấn đề cụ thể của bài: Mình viết 2 hàm rất nhỏ để giải quyết vấn đề này. Nhưng khó khăn là bạn dùng tên làm tiêu chuẩn trong khi tên rất dài tiềm ẩn sai sót làm các hàm tìm kiếm và tổng hợp theo điều kiện bị sai lệch. Ví dụ: Đố bạn 2 tên này có gì khác nhau: Fork R Gear Shift ( 24211 - KPH - 9001) và Fork R Gear Shift ( 24211 - KPH - 9001)
Do vậy, khi nhập nên dùng validation , Combobox hay chép dán chứ gõ trực tiếp e không ổn cho việc thống kê, kể cả các hàm trong 1 sheet. Mình tranh thủ viết đêm nên chưa soát hết được, bạn kiểm tra chỗ sao sai thì chắc là tên đó bị sai và dùng copy rồi paste vào thay thế tất cả các ô tên đó trên sheet tháng và sheet tổng hợp.
Hàm 1: Mình đổi CodeName các sheet tháng thành Tn. Ví dụ Sheet "Jan" thành T1
Mã:
Function Look(ByVal ch, cl1, cl2 As String, m As Date) As Double
Dim sh As Worksheet, i
Dim c As Range
Set sh = Choose(Month(m), T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, T12)
With sh.Range(cl1 & "1:" & cl1 & "500")
Set c = .Find(ch, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not c Is Nothing Then
Look = sh.Cells(c.Row, cl2)
Else
Look = 0
End If
End With
End Function
Cú pháp =Look(TenSP,Cot_ten,Cot_tim,Thang_tim)
Hàm 2: Hàm Sumif cải biên:
Mã:
Function LookSum(ByVal ch As String, cl As String, m As Date) As Double
Dim sh As Worksheet, i
Set sh = Choose(Month(m), T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, T12)
i = sh.[b65536].End(xlUp).Row
LookSum = WorksheetFunction.SumIf(sh.Range("C5:C" & i), "=" & ch, sh.Range(cl & "5:" & cl & i))
End Function
Cú pháp: =LookSum(Ten,Cot_tien,Thang)
Lưu ý trong các hàm này cột là ký tự cột. ví dụ cột D nhập "D"
2/Bạn nên cải tiến File không nhập thế này mà nhập chung 1 sheet DATA sau đó sử lý các báo cáo. Nen bổ xung cột Mã SP để việc tổng hợp và sử lý dữ liệu chính xác nhất.
Bạn nào giúp mình đoạn code này với : mình muốn nhấn vào nút Khoi 1 thì toàn bộ danh sách khối một sẽ copy sang sheet K1 , nút Khoi 2 thì sang sheet K2 ... mình làm hoài vẫn chưa được . mình gởi file nhờ các bạn sửa code dùm nha :
Macro này được triệu gọi từ 5 macro gắn với 5 nút lệnh của bạn
PHP:
Sub AdvFilter(Khoi As Byte)
Dim Sh As Worksheet, eRw As Long, ShName As String
eRw = [c65500].End(xlUp).Row
Range("B1:O" & eRw).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Y1:Y2"), CopyToRange:=Range("AA1:AN1"), Unique:=False
ShName = Switch(Khoi = 1, "K1", Khoi = 2, "K2", Khoi = 3, "K3", Khoi = 4, "K4", Khoi = 5, "K5")
Set Sh = Sheets(ShName)
[aa1].CurrentRegion.Copy Destination:=Sh.[B2]
Sh.Select: Set Sh = Nothing
End Sub
Cám ơn bạn HYen17 rất nhiều . Quả thật cách của bạn mình đọc không hiểu lắm , vì mình dân mới tập sự , nhưng vô tình nó gợi ý cho mình thay vì chỗ Criteria1:="1/" thì phải viết Criteria1:="1/*" là OK . Nó chạy rất tốt . Mình sẽ từ từ nghiên cứu thêm về cách của bạn .Nhưng dù sau mình cũng cám ơn bạn rất nhiều .
Mình không rành VB code, chỉ biết record macro rồi chỉnh sửa chút xíu cho phù hợp.
Mình đang có một file excel theo doĩ chi tiết hàng ngaỳ mỗi ngaỳ là 1 cột, kéo daì cho 12 tháng (file 1) nhưng report cần gủi cho sếp (file 2) chỉ cần paste value 7 cột của 7 ngaỳ gần nhất.
Có cách nào so sánh ngaỳ của từng cột trên file 1, nếu cột đó <= today+7 thì copy-paste vale qua file 2
Nhờ các bạn giúp mình viết đoạn code cho phù hợp
Rất mong nhận được phản hồi và xin cảm ơn nhiều
Để tránh phải sửa chữa và trọng tâm bạn nên có 1 file mẫu, bạn xoá bớt dữ liệu để nhel file nha. Trên file có sheet ghi chép hàng ngày và sheet báo cáo. Như vậy, mọi người sẽ tìm cách chép dữ liệu sang sheet báo cáo cho bạn tuỳ theo ngày báo cáo.
Mình không rành VB code, chỉ biết record macro rồi chỉnh sửa chút xíu cho phù hợp.
Mình đang có một file excel theo doĩ chi tiết hàng ngaỳ mỗi ngaỳ là 1 cột, kéo daì cho 12 tháng (file 1) nhưng report cần gủi cho sếp (file 2) chỉ cần paste value 7 cột của 7 ngaỳ gần nhất.
Có cách nào so sánh ngaỳ của từng cột trên file 1, nếu cột đó <= today+7 thì copy-paste vale qua file 2
Nhờ các bạn giúp mình viết đoạn code cho phù hợp
Rất mong nhận được phản hồi và xin cảm ơn nhiều
Để tránh phải sửa chữa và trọng tâm bạn nên có 1 file mẫu, bạn xoá bớt dữ liệu để nhel file nha. Trên file có sheet ghi chép hàng ngày và sheet báo cáo. Như vậy, mọi người sẽ tìm cách chép dữ liệu sang sheet báo cáo cho bạn tuỳ theo ngày báo cáo.
Cảm ơn bạn, nhưng bạn ơi, mình tính lồng đoạn VB code này vô 1 đoạn VB khác để bấm nút là tự động copy- paste value vô sheet report gửi đi, nếu được nhờ bạn giúp mình đoạn code để thực hiện copy theo điều kiện trong vòng 7 ngaỳ tiếp theo kể từ ngaỳ hiện taị nhé.
Đoạn code dưới đây chỉ đơn giản là thao tác copy toàn bộ rồi paste value và paste format qua file report gửi đi. Bạn tham khaỏ nhé, rất mong nhận được sự hỗ trợ của bạn.
Sub senddailyreport() 'Macro recorded 17/08/2010 by Annq
Còn đây là file phát sinh riêng và file báo cáo riêng. Khi lập báo cáo mở file báo cáo rồi nhập ngày nhấn nút báo cáo là code sẽ mở file phatsinh chép dữ liệu điền vào báo cáo.
Yêu cầu: 2 file có thể để bất cứ đâu miễn chúng cùng chung thư mục, bạn phải tải về giải nén ra ổ đĩa Code mới tìm thấy file Phat Sinh
Bạn ơi, cảm ơn bạn nhiều lắm, đúng là mình đang hí hoáy làm sao để liên kết ra cái file report khác thì được bạn hướng dẫn luôn.
Cho mình hỏi thêm chút xíu
Hiện giờ, mếu muốn baó cáo từ ngaý 1/9-7/9 thì phaỉ chọn ngaỳ baó caó là ngaỳ 7/9.
Nếu mình muốn baó cáo vẩn là từ ngày 1/9-7/9 nhưng gõ vô ô màu vàng là ngày 1/9 thì phải làm sao.
Thêm một chút xíu nữa, mình muốn để cái nút tạo báo cáo ở file phát sinh để file báo cáo gửi cho sếp hết sức đơn giản và không báo macro khi mở file ra (nếu không sếp hết hồn không thèm xem báo cáo mà tưởng virut)
Mình biết là phiền bạn nhưng rất mong được tiếp tục giúp đỡ
Việc chắc chắn sẽ dễ hơn trừ ngược. Bạn tham khảo Code để tìm hiểu đi. Mình sẽ có bài cho bạn nhưng không phải bây giờ.
Thông cảm nha, mình chỉ mong tốt cho bạn thôi.
Có 1 mẹo để sử dụng chính code không phải sửa nhiều là dòng
ng = sh1.[e2] bạn sửa thành ng = sh1.[e2] + 4
Nhưng đây không cơ bản vì code theo yêu cầu mới có thể gọn gàng hơn.
Việc chắc chắn sẽ dễ hơn trừ ngược. Bạn tham khảo Code để tìm hiểu đi. Mình sẽ có bài cho bạn nhưng không phải bây giờ.
Thông cảm nha, mình chỉ mong tốt cho bạn thôi.
Có 1 mẹo để sử dụng chính code không phải sửa nhiều là dòng
ng = sh1.[e2] bạn sửa thành ng = sh1.[e2] + 4
Nhưng đây không cơ bản vì code theo yêu cầu mới có thể gọn gàng hơn.
Cells(5,...) ở đây là dòng thứ 5 không? vậy còn cột >5 là sao? taị sao if cot>5 thì lấy 4, còn không thì lấy cot-2, taị sao rresize(16,..) 16 ở đây là gì
Khi nào rãnh bạn xem dùm 2 file của mình ứng dụng từ đoạn code của bạn, bị baó lỗi, rất cảm ơn bạn
Mình đã sửa báo cáo của bạn theo yêu cầu thay đổi của bạn. Bạn lưu ý Code để file nào thì cũng phải điều chỉnh theo.
Giờ hơi muộn, các nội dung khác sau vậy nha.
Được, nhưng chậm. Phải làm 1 sheet nguồn và dung công thức trích lọc dữ liệu tạo nguồn và link sang sheet đích. Mỗi khi tạo báo cáo phải nhập điều kiện ở file PS sau đó sang file báo cáo xem kết quả. Nhưng như vậy thà là luôn báo cáo ở file PS cho xong.
xin giúp đỡ tôi cách lọc dự liệu trong "sheet CT TToan" theo điều kiện thanh lý sau đó SUM cột thanh toán theo số Hợp đồng và copy sang sheet khác (trong bài tôi là sheet Tong hop), HĐồng nào đã thanh lý thì không xuất hiện trong "Sheet Tong Hop"
nếu đượ, tạo luôn cho tôi nút Tổnmg hợp
cám ơn các bạn nhiều
gửi bạn file đính kèm
xin giúp đỡ tôi cách lọc dự liệu trong "sheet CT TToan" theo điều kiện thanh lý sau đó SUM cột thanh toán theo số Hợp đồng và copy sang sheet khác (trong bài tôi là sheet Tong hop), HĐồng nào đã thanh lý thì không xuất hiện trong "Sheet Tong Hop"
nếu đượ, tạo luôn cho tôi nút Tổnmg hợp
cám ơn các bạn nhiều
gửi bạn file đính kèm
Private Sub CommandButton1_Click()
Dim Vung As Range, VungA As Range, Ws As Worksheet
Set Ws = Sheets("tong hop")
Ws.[a1].CurrentRegion.Clear
Set Vung = Range([B1], [B1].End(xlDown)).Offset(0, -1).Resize(, 8)
With Vung
.AutoFilter Field:=8, Criteria1:=" "
.Resize(, 7).SpecialCells(12).Copy Ws.[a1]
.AutoFilter
End With
Set VungA = Ws.Range(Ws.[g2], Ws.[g100].End(xlUp)(1))
Ws.[g500].End(xlUp)(2) = Application.WorksheetFunction.Sum(VungA)
VungA.Offset(0, -6) = [row(A:A)]
End Sub
Private Sub CommandButton1_Click()
Dim Vung As Range, VungA As Range, Ws As Worksheet
Set Ws = Sheets("tong hop")
Ws.[a1].CurrentRegion.Clear
Set Vung = Range([B1], [B1].End(xlDown)).Offset(0, -1).Resize(, 8)
With Vung
.AutoFilter Field:=8, Criteria1:=" "
.Resize(, 7).SpecialCells(12).Copy Ws.[a1]
.AutoFilter
End With
Set VungA = Ws.Range(Ws.[g2], Ws.[g100].End(xlUp)(1))
Ws.[g500].End(xlUp)(2) = Application.WorksheetFunction.Sum(VungA)
VungA.Offset(0, -6) = [row(A:A)]
End Sub
Cám ơn bạn, rất đúng ý tôi. nhưng khi tôi chèn thêm cột vào thì nó không còn đúng nữa. bạn có thể chỉnh lại cho tôi được không. nếu được phiền bạn giải thích từng câu lệnh giùm tôi luôn nhé vì chắn chắn sau này tôi phải chèn thêm nhiều cột vào do phát sinh. cám ơn bạn rất nhiều
Cám ơn bạn, rất đúng ý tôi. nhưng khi tôi chèn thêm cột vào thì nó không còn đúng nữa. bạn có thể chỉnh lại cho tôi được không. nếu được phiền bạn giải thích từng câu lệnh giùm tôi luôn nhé vì chắn chắn sau này tôi phải chèn thêm nhiều cột vào do phát sinh. cám ơn bạn rất nhiều
Cái "zụ" chèn cột mình đâu có giao từ đầu đâu, bảng của bạn tạo ra mà sao lúc làm lại phải chèn cột nhỉ? (cái này hổng hiểu)
Bạn chép code này vào nút rồi...tha hồ mà chèn
Híc
Thân
Mã:
Private Sub CommandButton1_Click()
Dim Vung As Range, Ws As Worksheet, I As Integer, VungA As Range
Set Ws = Sheets("tong hop")
Ws.[a1].CurrentRegion.Clear
Set Vung = [a1].CurrentRegion
I = Vung.Columns.Count
With Vung
.AutoFilter Field:=I, Criteria1:=" "
.Resize(, I - 1).SpecialCells(12).Copy Ws.[a1]
.AutoFilter
End With
Set VungA = Ws.Range(Ws.[b2], Ws.[b100].End(xlUp)(1)).Offset(0, I - 3)
Ws.[b500].End(xlUp)(2).Offset(0, I - 3) = Application.WorksheetFunction.Sum(VungA)
VungA.Offset(0, -(I - 2)) = [row(A:A)]
End Sub
Mình đã sửa báo cáo của bạn theo yêu cầu thay đổi của bạn. Bạn lưu ý Code để file nào thì cũng phải điều chỉnh theo.
Giờ hơi muộn, các nội dung khác sau vậy nha.
Bạn ơi, mình đã sử dụng được file của bạn gửi cho rồi, chạy rất tốt, chỉ bị một lỗi rất nhỏ đó là dòng thứ 30 của file báo cáo xuất hiện N/A (nhưng cái này mình delete bằng tay cũng được :-( , bạn cho hỏi có phaỉ resize(20 ..) có liên quan gì trong lỗi này không hả bạn? Taị sao mình chỉ có thề chọn range từ A10 đến BH10 trong file phát sinh mà không chọn được nhiều hơn?
Cho mình hỏi thêm một câu nữa: làm sao để báo cáo tự động hiểu nếu ngày thứ 7 và CN thì phải lấy (trên file phát sinh) cột kế tiếp.
Xin cảm ơn bạn nhiều, bạn ráng giúp mình thêm tí xíu nữa là công trình hoàn thành. Mình rất cảm ơn bạn
Xin giúp đỡ tôi cách lọc dự liệu và Sum trong "sheet CT TToan" theo điều kiện thanh lý sau đó SUM cột số tiềnthanh toántheo số Hợp đồng thành tổng số tiền đã thanh toán và copy sang Sheet "tong hop" theo mẫu đã tạo. Hợp Đồng nào đã thanh lý được đánh dấu "X" thì không xuất hiện trong "Sheet Tong Hop"
các điều kiện sau: 1. Hợp đồng nào đánh dấu "x" đã thanh lý thì không xuất hiện trong "Sheet Tong hop" 2. Sum cột số tiền thanh toán theo Số Hợp đồng thành Tổng số tiền đã thanh toán 3. được phép chèn thêm cột khi có nhu cầu phát sinh trong Sheet"TT KH" và Sheet"CT TToan" CÁM ƠN NHIỀU.
Bạn ơi, mình đã sử dụng được file của bạn gửi cho rồi, chạy rất tốt, chỉ bị một lỗi rất nhỏ đó là dòng thứ 30 của file báo cáo xuất hiện N/A (nhưng cái này mình delete bằng tay cũng được :-( , bạn cho hỏi có phaỉ resize(20 ..) có liên quan gì trong lỗi này không hả bạn? Taị sao mình chỉ có thề chọn range từ A10 đến BH10 trong file phát sinh mà không chọn được nhiều hơn?
Cho mình hỏi thêm một câu nữa: làm sao để báo cáo tự động hiểu nếu ngày thứ 7 và CN thì phải lấy (trên file phát sinh) cột kế tiếp.
Xin cảm ơn bạn nhiều, bạn ráng giúp mình thêm tí xíu nữa là công trình hoàn thành. Mình rất cảm ơn bạn
Thật vui file đó có ích cho bạn. Do hôm đó đêm quá khuya nên kiểm tra không kỹ. Giờ ta sử lý nha:
1/Lỗi dòng 30: Phát sinh do đoạn code sau : sh2.[B10:H30] = sh1.Cells(10, cot).Resize(20, 7).Value
Bạn đếm xem "B10:H30" có phải là 21 dòng không? Vậy mà ta chỉ Resize(20, 7) . Vậy là thiếu nguồn 1 dòng 30
Bạn sử lại như sau là xong: sh2.[B10:H30] = sh1.Cells(10, cot).Resize(21, 7).Value
2/Cái range("A10:BH10") là mình áng chừng thừa thãi cho 1 tháng chứ nếu thích bạn viết như sau chẳng sao (Vùng dò tìm lớn tốc độ có thể bị thiệt 1 chút)
3/Loại bỏ ngày thứ 7 và chủ nhật: Đơn giản nhất là tại sheet nào đó bạn làm 1 sheet hệ thống để lưu thông tin đơn vị, tháng. Từ tháng bạn tạo vùng Working_Dates. Cái vùng này làm tiêu đề cho dòng 10 và Validation chọn ngày thì đảm bảo không sai lệch được.
Thật đáng khen bạn khá thông minh, mò mẫm đúng điểm "chết" của code rồi đấy. Chúc bạn thành công.
Xin giúp đỡ tôi cách lọc dự liệu và Sum trong "sheet CT TToan" theo điều kiện thanh lý sau đó SUM cột số tiềnthanh toántheo số Hợp đồng thành tổng số tiền đã thanh toán và copy sang Sheet "tong hop" theo mẫu đã tạo. Hợp Đồng nào đã thanh lý được đánh dấu "X" thì không xuất hiện trong "Sheet Tong Hop"
Option Explicit
Sub TongHop()
Dim Sh As Worksheet, Sht As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim HpDg As String: Dim FaiTT As Double
Set Sht = Sheets("Tong Hop"): Set Sh = Sheets("TT KH")
Set Rng = Sht.[B6].Resize(23, 7): Rng.ClearContents
Rng.EntireRow.Hidden = False
Set Rng = Sh.Range(Sh.[B6], Sh.[B65500].End(xlUp))
For Each Cls In Range([B6], [B65500].End(xlUp))
If Cls.Offset(, 8).Value <> "x" Then
If Cls.Value <> HpDg Then
HpDg = Cls.Value
FaiTT = Rng.Find(HpDg, , xlFormulas, xlWhole).Offset(, 11).Value
With Sht.[B65500].End(xlUp).Offset(1)
.Resize(, 5).Value = Cls.Resize(, 5).Value
.Offset(, 5).Value = FaiTT
.Offset(, 6).Value = Cls.Offset(, 6).Value
End With
Else
With Sht.[G65500].End(xlUp).Offset(, 1)
.Value = .Value + Cls.Offset(, 6).Value
End With
End If
End If
Next Cls
Sht.Select
Range([b28], [b28].End(xlUp).Offset(2)).EntireRow.Hidden = True
End Sub
Xin giúp đỡ tôi cách lọc dự liệu và Sum trong "sheet CT TToan" theo điều kiện thanh lý sau đó SUM cột số tiềnthanh toántheo số Hợp đồng thành tổng số tiền đã thanh toán và copy sang Sheet "tong hop" theo mẫu đã tạo. Hợp Đồng nào đã thanh lý được đánh dấu "X" thì không xuất hiện trong "Sheet Tong Hop"
các điều kiện sau: 1. Hợp đồng nào đánh dấu "x" đã thanh lý thì không xuất hiện trong "Sheet Tong hop" 2. Sum cột số tiền thanh toán theo Số Hợp đồng thành Tổng số tiền đã thanh toán 3. được phép chèn thêm cột khi có nhu cầu phát sinh trong Sheet"TT KH" và Sheet"CT TToan" CÁM ƠN NHIỀU.
Sub THop()
Dim Clls As Range, Clls1 As Range, Rg As Range
TH.[A6:I65536].ClearContents
Set Clls1 = TH.[b6]
Set Rg = CT.Range(CT.[b6], CT.[b65536].End(xlUp))
With WorksheetFunction
For Each Clls In HD.Range(HD.[B7], HD.[b65536].End(xlUp))
If Clls.Offset(, 17) = "" Then
Clls.Resize(, 5).Copy Clls1
Clls1.Offset(, 5) = Clls.Offset(, 11)
Clls1.Offset(, 6) = .SumIf(Rg, Clls, Rg.Offset(, 6))
Clls1.Offset(, 7) = Clls1.Offset(, 5) - Clls1.Offset(, 6)
Set Clls1 = Clls1.Offset(1)
End If: Next
Set Clls = TH.[G65536].End(xlUp).Offset(1)
Set Rg = TH.Range(TH.[G6], Clls.Offset(-1))
Clls = .Sum(Rg)
Clls.Offset(, 1) = .Sum(Rg.Offset(, 1))
Clls.Offset(, 2) = .Sum(Rg.Offset(, 2))
End With
Set Clls = Nothing: Set Clls1 = Nothing: Set Rg = Nothing:
End Sub
Riêng chèn cột thì sửa code nhẹ nhàng hơn nhiều. Giờ muộn rồi, code của mình khá tiện cho việc tuỳ ý chèn cột nhưng đòi hỏi phải có tiêu đề nhận diện cột thanh toán cố định.
Sub THop()
Dim Clls As Range, Clls1 As Range, Rg As Range
TH.[A6:I65536].ClearContents
Set Clls1 = TH.[b6]
Set Rg = CT.Range(CT.[b6], CT.[b65536].End(xlUp))
With WorksheetFunction
For Each Clls In HD.Range(HD.[B7], HD.[b65536].End(xlUp))
If Clls.Offset(, 17) = "" Then
Clls.Resize(, 5).Copy Clls1
Clls1.Offset(, 5) = Clls.Offset(, 11)
Clls1.Offset(, 6) = .SumIf(Rg, Clls, Rg.Offset(, 6))
Clls1.Offset(, 7) = Clls1.Offset(, 5) - Clls1.Offset(, 6)
Set Clls1 = Clls1.Offset(1)
End If: Next
Set Clls = TH.[G65536].End(xlUp).Offset(1)
Set Rg = TH.Range(TH.[G6], Clls.Offset(-1))
Clls = .Sum(Rg)
Clls.Offset(, 1) = .Sum(Rg.Offset(, 1))
Clls.Offset(, 2) = .Sum(Rg.Offset(, 2))
End With
Set Clls = Nothing: Set Clls1 = Nothing: Set Rg = Nothing:
End Sub
Riêng chèn cột thì sửa code nhẹ nhàng hơn nhiều. Giờ muộn rồi, code của mình khá tiện cho việc tuỳ ý chèn cột nhưng đòi hỏi phải có tiêu đề nhận diện cột thanh toán cố định.
Yêu cầu này không khó, nhưng khó là ở chỗ là không biết bạn sẽ có thể chèn như thế nào (tiêu đề các cột ở dòng 5 có điểm nào thống nhất hay không? ...)
Sub THop()
Dim Clls As Range, Clls1 As Range, Rg As Range
TH.[A6:I65536].ClearContents
Set Clls1 = TH.[b6]
Set Rg = CT.Range(CT.[b6], CT.[b65536].End(xlUp))
With WorksheetFunction
For Each Clls In HD.Range(HD.[B7], HD.[b65536].End(xlUp))
If Clls.Offset(, 17) = "" Then
Clls.Resize(, 5).Copy Clls1
Clls1.Offset(, 5) = Clls.Offset(, 11)
Clls1.Offset(, 6) = .SumIf(Rg, Clls, Rg.Offset(, 6))
Clls1.Offset(, 7) = Clls1.Offset(, 5) - Clls1.Offset(, 6)
Set Clls1 = Clls1.Offset(1)
End If: Next
Set Clls = TH.[G65536].End(xlUp).Offset(1)
Set Rg = TH.Range(TH.[G6], Clls.Offset(-1))
Clls = .Sum(Rg)
Clls.Offset(, 1) = .Sum(Rg.Offset(, 1))
Clls.Offset(, 2) = .Sum(Rg.Offset(, 2))
End With
Set Clls = Nothing: Set Clls1 = Nothing: Set Rg = Nothing:
End Sub
Riêng chèn cột thì sửa code nhẹ nhàng hơn nhiều. Giờ muộn rồi, code của mình khá tiện cho việc tuỳ ý chèn cột nhưng đòi hỏi phải có tiêu đề nhận diện cột thanh toán cố định.
cám ơn bạn, nhưng vấn đề chèn thêm cột cho sheet TT KH và Sheet CT TToan vẫn chưa được giiải quyết.
nếu chèn thêm cột vào 2 sheet này thì kết quả sẽ sai.
Bạn vui lòng chỉnh lại dùm nhé. cám ơn bạn nhiều
Cái "zụ" chèn cột mình đâu có giao từ đầu đâu, bảng của bạn tạo ra mà sao lúc làm lại phải chèn cột nhỉ? (cái này hổng hiểu)
Bạn chép code này vào nút rồi...tha hồ mà chèn
Híc
Thân
Mã:
Private Sub CommandButton1_Click()
Dim Vung As Range, Ws As Worksheet, I As Integer, VungA As Range
Set Ws = Sheets("tong hop")
Ws.[a1].CurrentRegion.Clear
Set Vung = [a1].CurrentRegion
I = Vung.Columns.Count
With Vung
.AutoFilter Field:=I, Criteria1:=" "
.Resize(, I - 1).SpecialCells(12).Copy Ws.[a1]
.AutoFilter
End With
Set VungA = Ws.Range(Ws.[b2], Ws.[b100].End(xlUp)(1)).Offset(0, I - 3)
Ws.[b500].End(xlUp)(2).Offset(0, I - 3) = Application.WorksheetFunction.Sum(VungA)
VungA.Offset(0, -(I - 2)) = [row(A:A)]
End Sub
Bạn Concogia vui lòng giúp mình giải quyết lại vấn đề này nhé. CÁm ơn bạn nhiều Lọc và Sum dữ liệu theo điều kiện
Xin giúp đỡ tôi cách lọc dự liệu và Sum trong "sheet CT TToan" theo điều kiện thanh lý sau đó SUM cột số tiềnthanh toántheo số Hợp đồng thành tổng số tiền đã thanh toán và copy sang Sheet "tong hop" theo mẫu đã tạo. Hợp Đồng nào đã thanh lý được đánh dấu "X" thì không xuất hiện trong "Sheet Tong Hop"
các điều kiện sau: 1. Hợp đồng nào đánh dấu "x" đã thanh lý thì không xuất hiện trong "Sheet Tong hop" 2. Sum cột số tiền thanh toán theo Số Hợp đồng thành Tổng số tiền đã thanh toán 3. Được phép chèn thêm cột vào giữa cá cột khi có nhu cầu phát sinh trong Sheet"TT KH" và Sheet"CT TToan" để tính tóan lại giá trị hợp đồng hoặc để làm rõ thêm vấn đề. CÁM ƠN NHIỀU.
Bạn Concogia vui lòng giúp mình giải quyết lại vấn đề này nhé. CÁm ơn bạn nhiều Lọc và Sum dữ liệu theo điều kiện
Xin giúp đỡ tôi cách lọc dự liệu và Sum trong "sheet CT TToan" theo điều kiện thanh lý sau đó SUM cột số tiềnthanh toántheo số Hợp đồng thành tổng số tiền đã thanh toán và copy sang Sheet "tong hop" theo mẫu đã tạo. Hợp Đồng nào đã thanh lý được đánh dấu "X" thì không xuất hiện trong "Sheet Tong Hop"
các điều kiện sau: 1. Hợp đồng nào đánh dấu "x" đã thanh lý thì không xuất hiện trong "Sheet Tong hop" 2. Sum cột số tiền thanh toán theo Số Hợp đồng thành Tổng số tiền đã thanh toán 3. Được phép chèn thêm cột vào giữa cá cột khi có nhu cầu phát sinh trong Sheet"TT KH" và Sheet"CT TToan" để tính tóan lại giá trị hợp đồng hoặc để làm rõ thêm vấn đề. CÁM ƠN NHIỀU.
Thật tình mình cũng chưa thông cái "zụ" chèn cột, "bi' giờ còn "lượm" thêm một em ở sheet TT KH nữa, chơi khó nhau quá
Trong bài nếu có chèn bạn chèn ở cột G nhé, vài ba cột cũng được
Mã:
Private Sub CommandButton2_Click()
Dim Vung As Range, Ws As Worksheet, I As Integer, VungA As Range, J As Integer
Set Ws = Sheets("tong hop")
Ws.Range(Ws.[a6], Ws.[a6].End(xlDown)).Resize(, 13).Clear
Set Vung = [a5].CurrentRegion
I = Vung.Columns.Count
With Vung
.AutoFilter Field:=I, Criteria1:=" "
.Offset(1).Resize(, I - 4).SpecialCells(12).Copy Ws.[a6]
.Resize(, 1).Offset(1, I - 3).Copy Ws.[n6]
.AutoFilter
End With
Set VungA = Ws.Range(Ws.[b6], Ws.[b6].End(xlDown))
With VungA
.Offset(0, 6).FormulaR1C1 = "=SUMIF(shd,RC[-6],tien)"
.Offset(0, 6).Value = .Offset(0, 6).Value
.Offset(0, 12).Clear
End With
For J = VungA.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountIf(VungA, VungA(J)) > 1 Then Ws.Rows(J + 5).Delete
Next
VungA.Offset(0, -1) = [row(A:A)]
VungA.Offset(0, 5).FormulaR1C1 = "=INDEX(tong,MATCH(RC[-5],hd,0))": VungA.Offset(0, 5).Value = VungA.Offset(0, 5).Value
VungA.Offset(0, 7).FormulaR1C1 = "=RC[-2]-RC[-1]": VungA.Offset(0, 7).Value = VungA.Offset(0, 7).Value
End Sub
Mình nghĩ bảng của bạn tạo ra bạn cứ dự trù cho đủ cột, lúc lọc mình bỏ đi bao nhiêu cột cũng được mà ( bỏ dễ hơn chèn thêm)
Nói vui thôi, có gì bàn tiếp (Thầy Sa va Thầy Sealand trợ giúp bạn bài này là Thầy mình í)
Híc
Các bạn giúp mình vấn đề này với
Mình có 1 bảng như sau
A1 A2 A3 A4 A5
AABBC x
CCDDC X
mình muốn tạo vòng lặp để trích 2 ký tự đầu cột A1 sang cột A3, và 2 ký tự tiếp theo sang cột A4 và ký tự cuối cùng sang cột A5
Nếu có thể được thì bạn giải thích giúp mình các lênh dùng trong đó với nhé
Cám ơn trước
Lọc danh sách sang từng sheet cũng đơn giản thôi, nhưng nếu sử dụng công thức thì trong bảng tính của bạn sẽ 'hơi bị nhiều" công thức, mình đề nghị một cách lọc bằng VBA, bạn nhập, hoặc sửa chữa, thêm bớt dữ liệu xong thì bấm cái nút nằm kế bên dữ liệu sẽ đưa về các sheet
Thân
Mình thấy cách của bạn hay qúa nhưng không sao sửa để áp dụng bài này được. Mong bạn giúp mình nhé. mình gửi flie đính kèm, nếu có kết quả, xin bạn đẩy thẳng về mail của mình nhé, vì khi thoát ra khỏi diễn đàn thì khó tìm lại bài giải của bạn được. Cảm ơn thật nhiều. Mail: Ngoctuan277@gmail.com
Nhân đây cũng kính nhờ các cao thủ giúp em giải quyết bài toàn này với ạ, em đang cần lắm.
Mục đích: Khi nhấn button "Update" sẽ copy các cell thỏa mãn điều kiện như sau:
Copy cell H6 tại sheet "NHACLICH" sang cell F4 vì F4 nằm ở dòng 1(mảng CSDL!A4:H1000) = giá trị tại NHACLICH!J6. Tương tự đối với NHACLICH!H7 sẽ được copy sang CSDL!F6;NHACLICH!I6 sẽ được copy sang CSDL!G4; NHACLICH!I7 sẽ được copy sang CSDL!G6. VBA em viết như sau, xin các anh sửa lỗi giùm:
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer
Dim iValueCopy1 As String, iValueCopy2 As String
For i = 1 To 100
j = Worksheets("Sheet1").Range("J5").Offset(i)
iValueCopy1 = Worksheets("Sheet1").Range("H5").Offset(i)
iValueCopy2 = Worksheets("Sheet1").Range("I5").Offset(i)
Worksheets("Sheet2").Range("F3").Offset(j) = iValueCopy1
Worksheets("Sheet2").Range("G3").Offset(j) = iValueCopy2
Worksheets("Sheet2").Range("A1").Select
Next i
End Sub
Cho em hỏi tý, em có 1 file chứa danh sách có 1 cột được đánh true hoặc false bây giờ em muốn COPY hết từ dòng false đầu tiên (1 theo số tứ tự) đến dòng false thứ 9 và lấy thêm dòng có giá trị = TRUE. (vì e để dòng chia hết cho 10 = TRUE) copy ra 1 sheet mới. Em gửi file đính kèm ạ
.Cứ mỗi lần đến dòng TRUE thứ 10 này thì lặp tiếp tục
Thanks ban concogia vì file excel của bạn rất hay. Minh cũng có 1 bài toán tương tự nhưng chưa hoàn thiện được. Mong ban giúp mình đoạn code nhé! Mình sẽ gửi bạn file của mình
gới bạn giao_nguyenthat
mình đã xem câu trả lời của bạn cho câu hỏi của bạn thanhtungpt1 nhưng mình áp dụng vào bài tập của mình thì không được do mình chưa hiểu rõ lắm.
nhờ bạn chỉ giúp bài tập mình với.
mình muốn trích lọc dữ liệu từ master lish sang các sheet khác với điều kiện là theo code line (tệp đính kèm)
rất mong bạn giúp đỡ. thank bạn nhiều
Tôi cần viết code cho form F1-Day: nếu cột "MaGV" trùng thì ghép lại 1 dòng với điều kiện cột "tenmon" các môn cách nhau dấu phẩy "," còn cột "HKI_1-14" cộng các giá trị lại.
Rất cám ơn!
Tôi có 1 file access đang thực hiện, cần mọi người giúp đỡ, dưới đây là liên kết: Phan cong 2020.accdb
drive.google.com
Tôi cần viết code cho form F1-Day: nếu cột "MaGV" trùng thì ghép lại 1 dòng với điều kiện cột "tenmon" các môn cách nhau dấu phẩy "," còn cột "HKI_1-14" cộng các giá trị lại.
Rất cám ơn!
