Cháu xin lỗi bác HYen. Lúc đầu cháu chủ quan, cứ nghĩ có thể dùng được công thức nhưng mình còn kém, không làm được nên mới đưa 1 bảng dữ liệu ngắn lên để hỏi công thức. Lần sau cháu sẽ rút kinh nghiệm ạ.
Cháu cảm ơn bác ChanhTQ.
Macro này đã chỉnh sửa 2 chổ & làm việc chắc chắn cũng như nhanh hơn xíu nè:
Option Explicit
Sub ThongKeNgay()
Dim Sh As Worksheet, Rng As Range, Arr(), sRng As Range, Arr0()
Dim Rws As Long, J As Long, Col As Integer, W As Integer, Z As Integer, Tmr As Double
Tmr = Timer()
Sheets("Thong Ke NG Hang Ngay").Select
Arr0() = Range([c3], [c3].End(xlToRight)).Value
Rws = [b4].CurrentRegion.Rows.Count
Range("C4:iV4").Resize(Rws).ClearContents '<=|'
Set Sh = ThisWorkbook.Worksheets("Theo Doi Loc, Sua")
Col = Sh.[iv5].End(xlToLeft).Columns
Rws = Sh.[F5].End(xlDown).Row
Arr() = Sh.[F6].Resize(Rws, Col).Value
Set Rng = Range([b4], [b4].End(xlDown))
For J = 1 To Rws
If Arr(J, 10) <> "" Then
Set sRng = Rng.Find(Arr(J, 1), , xlFormulas, xlWhole)
If sRng Is Nothing Then '<=|'
MsgBox "Nothing": Exit Sub
Else
sRng.Offset(, -1).Interior.ColorIndex = 38
End If '*'
For W = 10 To (Col + 10) Step 4
If Arr(J, W) = "" Then
Exit For
Else
For Z = 1 To UBound(Arr0(), 2)
If Arr(J, W) = Arr0(1, Z) Then
With Cells(sRng.Row, Z + 2)
.Value = .Value + Arr(J, W + 2)
End With
Exit For '<=|'
End If
Next Z
End If
Next W
End If
Next J
[cw1].Value = Timer() - Tmr
End SubCháu cảm ơn bác HYen.
Vậy thôi, cháu không bỏ đi đâu. Cháu cứ điền ngày, ghi số liệu thu được cho ngày trống là 0.
Khi thử mình đã xóa dòng 102 đi rồi nên nó vẫn là duy nhất. Mình hiểu điều này mà nên đã dùng lệnh tô màu cho những mã lặp, mã nào lặp xóa đi ngay, tránh sai sót.
Mình không để trống đâu.
Cháu chạy thử ok rồi. cháu vừa tìm hiểu cả câu lệnh có chữ xfd3 của bác, Vùng chọn rộng như vậy thì không còn lo gì nữa. Cảm ơn bác Ba Tê.
Bác Ba Tê ơi, hôm nay cháu làm thì hiện ra lỗi này "subscript out of range"
