THÌ CHỌN BÁO CÁO THEO TUẦN, TẤT CẢ NHỮNG GÌ SẼ ĐC QUA SHEET TUẦN (VI DU FILE DINH KEM), MỞ TỪNG SHEET XEM
Tức là sheet tổng hợp nó có nhiều loại (cột tuần và cột tình trạng), nôm na lọc tuần nào ra sheet tuần nấy!
Bạn giúp mình như vậy nhé! và cái báo cáo kết hợp giữa tuần và tình trạng nữa! mình dùng advanced filter bằng tay đc mà thấy nó chậm!
ở đây mình ví dụ cho bạn hiểu, nếu cần cả 2 sẽ cùng 1 dạng!
nói thật, kiến thức VBA mình kém mới hỏi anh em! bạn giúp đc thì giúp mình rất chân thành cảm ơn! nhưng thấy độ khó dễ trong bạn! dù sao cũng rất cám ơn bạn đã quan tâm topic của mình!
cách đó đc và hay! nhưng mình chưa có code đó ngoài dùng advanced filter , bạn hộ mình nhe!
CHÂN THÀNH CẢM ƠN BẠN!
Đây bạn xem.Đây là code tìm kiếm đủ cả 3 điều kiện.Nếu muốn tìm kiếm ít điều kiện hơn thì mình chỉnh sau.
Sub baocao()
Dim arr, arr1
Dim a As Long, b As Long, c As Long, lr As Long, i As Long, j As Long
Dim dk As String, dks As String
With Sheets("Tong Hop")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr < 2 Then MsgBox "khong co du lieu": Exit Sub
arr = .Range("A2:W" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 23)
End With
With Sheets("bao cao")
dk = .Range("C3").Value & "#" & .Range("c4").Value & "#" & .Range("C5").Value
For i = 1 To UBound(arr, 1)
dks = arr(i, 2) & "#" & arr(i, 3) & "#" & arr(i, 12)
If UCase(dk) = UCase(dks) Then
a = a + 1
arr1(a, 1) = a
For j = 2 To 23
arr1(a, j) = arr(i, j)
Next j
End If
Next i
b = .Range("B" & Rows.Count).End(xlUp).Row
If b > 11 Then .Range("A12:W" & b).ClearContents
If a Then .Range("A12").Resize(a, 23).Value = arr1
End With
End SubCám ơn bạn rất nhiều!
Vấn đề thứ 4 không giải quyết được trong sub đấy.Vì tìm kiếm của bạn chỉ có 1 tuần nên nó không hiểu.Còn mấy vấn đề trước thì được.Bạn nên chỉnh lại dữ liệu.Mình code luôn 1 thể.Ví dụ thêm 1 cái báo cáo là từ tuần thứ mấy đến tuần thứ mấy.
CÁM ƠN BẠN, ĐỂ MÌNH CHỈNH FILE VÀ GỬI LẠI BẠN
Đây bạn xem.
Sub baocao1()
Dim arr, arr1, T, aT, aso()
Dim a As Long, b As Long, c As Long, lr As Long, i As Long, j As Long, k As Long
Dim dk As String, dks As String, Tr As Long, Ts As Long, d As Long
With Sheets("Tong Hop")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr < 2 Then MsgBox "khong co du lieu": Exit Sub
arr = .Range("A2:W" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 23)
End With
With Sheets("bao cao")
T = Array(.Range("c4").Value, .Range("C5").Value, .Range("c6").Value, .Range("c7").Value)
aT = Array(4, 13, 3, 12)
If .Range("C2").Value = Empty Then Tr = 0 Else Tr = Right(.Range("C2").Value, 2)
If .Range("C3").Value = Empty Then Ts = 100 Else Ts = Right(.Range("C3").Value, 2)
For i = LBound(T) To UBound(T)
If T(i) <> Empty Then
c = c + 1
If dk = Empty Then
dk = T(i)
Else
dk = dk & "#" & T(i)
End If
ReDim Preserve aso(1 To c)
aso(c) = aT(i)
End If
Next i
For i = 1 To UBound(arr, 1)
dks = Empty
On Error Resume Next
For k = LBound(aso) To UBound(aso)
If dks = Empty Then
dks = arr(i, aso(k))
Else
dks = dks & "#" & arr(i, aso(k))
End If
Next k
d = Right(arr(i, 2), 2)
If d >= Tr And d <= Ts Then
If UCase(dk) = UCase(dks) Then
a = a + 1
arr1(a, 1) = a
For j = 2 To 23
arr1(a, j) = arr(i, j)
Next j
End If
End If
Next i
b = .Range("B" & Rows.Count).End(xlUp).Row
If b > 11 Then .Range("A12:W" & b).ClearContents
If a Then .Range("A12").Resize(a, 23).Value = arr1
End With
End SubCám ơn bạn nhiều lắm.
