Tự động copy có điều kiện sang sheet khác

[thanhtungpt1]

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 :

 

[quean]

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.

Ban Sealand oi, cảm ơn bạn nhiều lắm, nếu vậy thì mình sẽ dùng theo cách trừ ngược,


Bạn ơi, vì mình không được học căn bản mà tự mò, bạn gỉaỉ thích giùm mình đoạn code sau

sh1.[b4:b19].Resize(, IIf(cot > 5, 5, cot - 1)) = Wb2.Sheets(i).Cells(5, cot - IIf(cot > 5, 4, cot - 2)).Resize(16, IIf(cot > 5, 5, cot - 1)).Value

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

 

[sealand]

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.

 

[quean]

Cảm ơn sự giúp đỡ nhiệt tình của bạn. Many many thanks

 

[cazonda]

Có thể dùng công thức cho tất cả các Sheets kg ah? Và không dùng code

 

[sealand]

Đượ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.

 

[hung1]

lọc dữ liệu

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

 

[concogia]

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

Thử với cái này xem, không biết đúng ý chưa nữa

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

 

[hung1]

lọc dữ liệu

Thử với cái này xem, không biết đúng ý chưa nữa

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

 

[concogia]

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

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

 

[quynhvan06101312]

Dùng coppy sheet Group được không nhỉ

 

[quean]

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.

Chào bạn Sealand,

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

 

[hung1]

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ền thanh toán theo 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.

 

[sealand]

Chào bạn Sealand,

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)

cot = WorksheetFunction.Match(sh1.[a5], sh1.Range("A10:IV10"), 0)

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.

 

[SA_DQ]

Xem thêm trong file nha

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ền thanh toán theo 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

 

[sealand]

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ền thanh toán theo 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 dùng code này xem sao:

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.

 

[boyxin]

Bạn dùng code này xem sao:

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.

Nếu trong vùng [J6:J10] xóa bớt một vài chữ " x " thì code không còn chính xác

@hung1

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"

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? ...)

 

[hung1]

cám ơn bạn, nhưng bạn tính tổng số tiền đã thanh toán của 01 hợp đồng không đúng trong sheet"Tong hop".
bạn tính lại dùm nhé. cám ơn nhiều

 

[hung1]

Bạn dùng code này xem sao:

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

 

[hung1]

Nhiều khi phát sinh tính toán nên phải chèn thêm cột vào giữa các cột đang có để tính toán lại giá trị Hợp đồng
hoặc lảm rõ thêm vấn đề

 

[hung1]

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

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ền thanh toán theo 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.
​