Giúp mình cách lọc dữ liệu theo ngày, tên thuốc và khoa !

[phananhduc]

mình có vấn đề nhờ các bạn giúp mình như sau.
Tại Sheet "NKXKhoLe" là nhật ký xuất kho lẻ cho các khoa.
Tại Sheet "TongHopNgay" mình muốn tổng hợp từng khoa theo từng loại thuốc và theo từng ngày.
Tại Sheet "TongHopKhoa" sẽ là tổng hợp của tất cả các khoa theo từng loại thuốc để lấy tổng số.
Các bạn giúp mình nhé, cám ơn rất nhiều

 

[SA_DQ]

Ngán, để mình cho!. . .(Nhưng cũng khá hao tài nguyên!)

Macro của bạn đây:

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
 If Not Intersect(Target, [V1]) Is Nothing Then AdvFilter
[B]End Sub[/B]

Sub AdvFilter()
 On Error GoTo Loi
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Clls As Range
 Dim eRw As Long:                      Dim MyAdd As String
 
 Set Sh = Sheets("NKXuatKL"):          Set Rng = [B6].CurrentRegion
 eRw = Rng.Rows.Count - 5
 [E6].Resize(eRw, Rng.Columns.Count - 5).ClearContents
 eRw = Sh.[A65500].End(xlUp).Row
 Set Rng = Sh.Range("A5:G" & eRw):     Application.ScreenUpdating = False
 Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
   Sh.[J1].Resize(2), CopyToRange:=Sh.[I5].Resize(, 6), Unique:=False
 eRw = Sh.[I65500].End(xlUp).Row:      Set Rng = Sh.Range("I5:N" & eRw)
 Rng.Sort Key1:=Sh.[L6], Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1
 Set Rng = Sh.[l5].Resize(eRw)
 For Each Clls In Range([B6], [B65500].End(xlUp))
   Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
   If sRng Is Nothing Then
      Clls.Offset(, 3).Value = 0
   Else
      MyAdd = sRng.Address
      Do
         With sRng.Offset(, -1)
            Clls.Offset(, 2 + .Value).Value = .Offset(, 2).Value
         End With
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   End If
 Next Clls
Err_:             Exit Sub
Loi:
   If Err <> 13 Then MsgBox Clls.Address, , Err
   Resume Err_
End Sub

Hướng dẫn cách xài:
Chọn mã kho lẽ ở 'V1' tại trang 'THopNgay'

 

[ptm0412]

làm bằng Pivot table cho nhẹ máy nhẹ người.

 

[SA_DQ]

Xong câu 2 luôn đây, bằng macro để tham khảo

Option Explicit
Sub THKhoa()
 Dim Clls As Range, Rng As Range, Kho As Range, Sh As Worksheet
 Dim Cll As Range, Rngk As Range
 
 Set Sh = Sheets("NKXuatKL"):                   Sheets("THopKhoa").Select
 Set Kho = [e5].Resize(, [e5].End(xlToRight).Column - [e5].Column)
 Set Rng = Sh.Range("C5:G" & Sh.[A65500].End(xlUp).Row)
 
 For Each Clls In Kho
   Sh.[L2].Value = Clls.Value
   Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
      Sh.[L1].Resize(2), CopyToRange:=Sh.[I5].Resize(, 4), Unique:=False
   Set Rngk = Sh.Range(Sh.[j5], Sh.[j5].End(xlDown))
   For Each Cll In Range([B6], [B65500].End(xlUp))
      With Application.WorksheetFunction
         Cells(Cll.Row, Clls.Column).Value = .SumIf(Rngk, Cll.Value, Rngk.Offset(, 1))
      End With
   Next Cll
 Next Clls
End Sub

 

[phananhduc]

Hix, mình không biết dùng Pivot và Marco. Không có cách nào dùng công thức àh bạn ! Dù sao mình cũng cám ơn HYen và PTM nhé.

 

[dat_butmuc]

Hix, mình không biết dùng Pivot và Marco. Không có cách nào dùng công thức àh bạn ! Dù sao mình cũng cám ơn HYen và PTM nhé.

Đối với dữ liệu của bạn mà dùng công thức thì có chạy đến sang năm cũng chưa xong bảng tính???
Các giải pháp tối ưu, ngắn gọn và để Excel chạy được đã được Bác PTM và HYen giải quyết rồi?
Công thức cũng có thể giải quyết được nhưng không nên dùng với dữ liệu lớn như của bạn...
Thân mến và nghiên cứu thử xem?