Nhờ tạo thêm trường dữ liệu theo thôn đội (1 người xem)

[nam_thang3982]

Nhờ tạo thêm sheet list danh sách theo khu, và thống kê điểm theo khu

file excel của mình đã có trường dữ liệu theo lớp, bạn nào giúp mình thêm trường dữ liệu theo thôn đội với. Tại file này người khác giúp mình nên giờ loay hoay mãi mình không thể làm được

 

[chibi]

file excel của mình đã có trường dữ liệu theo lớp, bạn nào giúp mình thêm trường dữ liệu theo thôn đội với. Tại mình không làm nên giờ loay hoay mãi không thể làm được

Thực sự là mình không hiểu câu hỏi.

 

[SA_DQ]

Bạn xem đúng như ý chưa nha!

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [K3]) Is Nothing Then
   Dim Zz As Byte:                                    Dim MyAdd As String
   Dim Sh As Worksheet, Rng As Range, sRng As Range
      
   Application.ScreenUpdating = False
   [B6:O1234].ClearContents
   For Zz = 1 To 4
      Set Sh = Sheets(Choose(Zz, "K9", "K8", "K7", "K6"))
      Set Rng = Sh.Range("F1:F" & Sh.[F65500].End(xlUp).Row)
      Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         MyAdd = sRng.Address
         Do
            With [b65500].End(xlUp)
               .Offset(1).Resize(, 6).Value = sRng.Offset(, -2).Resize(, 6).Value
               .Offset(1, 7).Resize(, 8).Value = sRng.Offset(, 5).Resize(, 8).Value
            End With
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      End If
      '?'
   Next Zz
 End If
End Sub

Xin biếu thêm macro lập danh sách địa phương duy nhất, phục vụ cho sự lựa chọn tại [K3]

[B]Private Sub Worksheet_Activate()[/B]
 Dim Jj As Byte:                                      Dim Sh As Worksheet
 
 Columns("AJ:AJ").Delete Shift:=xlToLeft:             [aj1].Value = "Khu"
 Application.ScreenUpdating = False
 For Jj = 1 To 4
   Set Sh = Sheets(Choose(Jj, "K9", "K8", "K7", "K6"))
   Sh.Range("F2:F" & Sh.[F65500].End(xlUp).Row).Copy Destination:= _
         [aj65500].End(xlUp).Offset(1)
 Next Jj
 [Aj1:Aj5678].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[AI1], Unique:=True
 [B6:O1234].ClearContents

[B]End Sub[/B]

 

[nam_thang3982]

File của mình có 1 sheet lớp để list danh sách cho từng lớp, và có sheet thống kê điểm cho từng lớp( các sheet này bị ẩn - dùng chế độ unhide biết ngay). Bạn giúp mình cũng trên file đó tạo 1 sheet để list danh sách theo thôn đội ( đó là cột khu có K1,K2,....) và 1 sheet thống kê điểm cho từng khu ( làm ví dụ để mình làm cho các khu còn lại ).

 

[nam_thang3982]

file đính kèm bạn gửi cho mình chưa list được danh sách theo khu, và chưa có thống kê điểm theo khu, bạn giúp mình với