Dùng VBA trong file này như thế nào để thay thế công thức trích dử liệu (2 người xem)

[ndu96081631]

Chào các bạn!
Tôi có file này: Trích dử liệu theo ngày tháng và 1 điều kiện khác (2 điều kiện)
Hiện tôi đang dùng công thức để trích... Nhưng xin hỏi giã sử tôi muốn thay toàn bộ công thức trên bằng cách dùng VBA để trích xuất thì phải làm thế nào?
Các bạn chỉ cần chú ý công thức nằm trong vùng A13 đến AF 29
Tôi định dùng For nhưng thấy chậm quá...
Xin các cao thủ gợi ý 1 cách khác hoàn chỉnh hơn (về mặc tốc độ)

 

[ndu96081631]

Ai cha...
Khó lắm hay sao mà hỏng thấy ai ngó ngàng đến vậy trời
Hic...

 

[phamduylong]

Ai cha...
Khó lắm hay sao mà hỏng thấy ai ngó ngàng đến vậy trời
Hic...

Bạn nên nhập một số dữ liệu bên sheet DATA để thử, chứ toàn là 0 thì khị VBA chạy làm sao kiểm chứng được.
Theo tôi, nếu đã sử dụng VBA để trích dữ liệu thì bỏ hết các công thức bên Report, giao cho VBA làm luôn thì hay hơn.

 

[ThuNghi]

Ai cha...
Khó lắm hay sao mà hỏng thấy ai ngó ngàng đến vậy trời
Hic...

Đâu có gì phải dùng đao to búa lớn.
Khi xác định được Area thì ta đã biết Dept ie từ cột thứ mấy - > EndCol
Biết ngày tháng truy xuất thì ta xác định dòng.
Việc còn lại là copy paste transpose => report.
Copy dòng Dept theo cột xác định và paste transpose vào A15, A14="All" và sum.

 

[ndu96081631]

Bạn nên nhập một số dữ liệu bên sheet DATA để thử, chứ toàn là 0 thì khị VBA chạy làm sao kiểm chứng được.
Theo tôi, nếu đã sử dụng VBA để trích dữ liệu thì bỏ hết các công thức bên Report, giao cho VBA làm luôn thì hay hơn.

Có dử liệu mà anh! Nằm ở tháng 10 ấy!

Đâu có gì phải dùng đao to búa lớn.
Khi xác định được Area thì ta đã biết Dept ie từ cột thứ mấy - > EndCol
Biết ngày tháng truy xuất thì ta xác định dòng.
Việc còn lại là copy paste transpose => report.
Copy dòng Dept theo cột xác định và paste transpose vào A15, A14="All" và sum.

Uh nhỉ! Sao mình không nghĩ ra vụ Transpose này ta? Có lý à nha! Để làm thử xem!

 

[ThuNghi]

Có dử liệu mà anh! Nằm ở tháng 10 ấy!

Uh nhỉ! Sao mình không nghĩ ra vụ Transpose này ta? Có lý à nha! Để làm thử xem!

Xin tham gia 1 code, CN buồn không ai mời.

Option Explicit
Sub TaoBC()
Dim FCol As Long, ECol As Long, FRow As Long, ERow As Long, DeptNo As Integer, Idate As Long
Dim Dept As Range, StarDate As Date, Dates As Range, Data As Range
Dim WF As WorksheetFunction
Set WF = WorksheetFunction
With Application
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
Sheet1.Select
Range("A15:AF30").ClearContents
DeptNo = [AI11]
Set Dept = Range("AK12:AK45")
FCol = WF.Match(DeptNo, Dept.Offset(, -1), 0) + 1
ECol = WF.CountIf(Dept.Offset(, -1), DeptNo) + FCol - 1
StarDate = (DateSerial([AN10], [am11], 1))
Idate = CLng(StarDate)
Set Dates = Sheet2.Range("A7:A" & Sheet2.[a65000].End(xlUp).Row)
FRow = WorksheetFunction.Match(Idate, Dates) + 6
ERow = FRow + [AM10] - 1
With Sheet2
    Set Data = Range(.Cells(FRow, FCol), .Cells(ERow, ECol))
End With
Data.Copy
[B15].PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Range("A15:A" & 15 + ECol - FCol).Value = Dept.Range(Cells(FCol - 1, 1), Cells(ECol - 1, 1)).Value
Application.CutCopyMode = False
Set Data = Nothing
Set Dates = Nothing
Set WF = Nothing
Set Dept = Nothing
With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub