Giúp code lọc theo tháng & nhóm sau đó Paste các nhóm trên cùng một bảng tính!

hands
20/09/2012
Excel Ứng Dụng

Em chào thầy cô & anh chị!
Vui lòng giúp em code như sau
1/ Sheet NhapBan : là sheet nhập dữ liệu
2/ Sheet BanRa : là kết quả sau khi chạy code
Tại sheet BanRa : sau khi chọn tháng tại cell G7, thì sẽ lọc theo tháng tại cột A và sắp xếp theo nhóm ở cột B của sheet NhapBan sẽ cho kết quả như sau:

a/ Tại Sheet BanRa, Bắt đầu dòng 18->118: tập hợp những dữ liệu có cùng tháng với G7 và nhóm 1
b/ Tại Sheet BanRa, Bắt đầu dòng 121->221: tập hợp những dữ liệu có cùng tháng với G7 và nhóm 2
c/ Tại Sheet BanRa, Bắt đầu dòng 224->324: tập hợp những dữ liệu có cùng tháng với G7 và nhóm 3
d/ Tại Sheet BanRa, Bắt đầu dòng 327->527: tập hợp những dữ liệu có cùng tháng với G7 và nhóm 4
e/ Tại Sheet BanRa, Bắt đầu dòng 530->580: tập hợp những dữ liệu có cùng tháng với G7 và nhóm 5
————-
Khi lọc xong thì ẩn những dòng trống, chỉ chừa 1 hàng trồng ở cuối dòng mỗi nhóm
Số thứ tự của Sheet BanRa là do em làm công thức
Em cảm ơn!
———-

Có phải là lấy từ sh Nhapban sang BKBan theo cột A # G7?
Sao thấy HD 000549 ngày 01/08 mà cột A là 7
Đối với Banra kg nhất thiết cần cột A vì đã viết hay hủy thì đương nhiên phải kê kỳ kk = tháng của ngày HD. => Lấy theo cột B và F của NhapBan?
Phần sh BanRa bạn đã dự trù đủ số dòng? => Phần đưa vào sẽ đơn giản hơn tạo mới.
Hôm nay HongVan lấn sang kk thuế à.

1/Ngày tháng cột F so với tháng ở cột A, em quên sửa —> nhưng điều này kg quan trọng, vì thực tế ở những hóa đơn đầu Vào thì tháng trên hóa đơn & tháng kê khai có thể khác nhau mà!
2/ Em muốn lấy cột A để lọc, Mục đích để em muốn tự mình áp dụng vào các hóa đơn đầu vào
3/ Trước mắt tạm thời dự trù số lượng dòng như vậy, khi cần mở rộng thì em có thể chỉnh code (Viết code thì kg biết, nhưng sửa thì có thể)
4/ Cũng fải kiếm thêm cơm để nuôi !
Em cảm ơn!

Trước mắt tạm khai 5 Arr để lấy dữ liệu, rút gọn lại thành mảng 3 chiều sau, mà dùng nhiều arr cho dễ hiểu.
Có thế thay đổi điều kiện cột A hay cột F.
Sub TaoBK()
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Dim eR&, i&, k&, iM&, iNhom&
Dim s1&, s2&, s3&, s4&, s5&
Dim sArr, Arr01, Arr02, Arr03, Arr04, Arr05
With Sheets("BanRa")
iM = .
.Rows("18:580").EntireRow.Hidden = False
.Range("B18:K118").ClearContents
.Range("B121:K221").ClearContents
.Range("B224:K324").ClearContents
.Range("B327:K527").ClearContents
.Range("B530:K580").ClearContents
End With
With Sheets("NhapBan")
eR = .Cells(65000, "E").End(xlUp).Row
sArr = .Range("A18:L" & eR).Value
End With
ReDim Arr01(1 To 100, 1 To 10)
ReDim Arr02(1 To 100, 1 To 10)
ReDim Arr03(1 To 100, 1 To 10)
ReDim Arr04(1 To 100, 1 To 10)
ReDim Arr05(1 To 100, 1 To 10)
For i = 1 To UBound(sArr)
'If Month(sArr(i, 6)) = iM Then'
If CLng(sArr(i, 1)) = iM Then
iNhom = sArr(i, 2)
Select Case iNhom
Case Is = 4
s4 = s4 + 1
Arr04(s4, 1) = s4 'soTT
For k = 2 To 10
Arr04(s4, k) = sArr(i, k + 2)
Next k
Case Is = 3
s3 = s3 + 1
Arr03(s3, 1) = s3 'soTT
For k = 2 To 10
Arr03(s3, k) = sArr(i, k + 2)
Next k
Case Is = 2
s2 = s2 + 1
Arr02(s2, 1) = s2 'soTT
For k = 2 To 10
Arr02(s2, k) = sArr(i, k + 2)
Next k
Case Is = 1
s1 = s1 + 1
Arr01(s1, 1) = s1 'soTT
For k = 2 To 10
Arr01(s1, k) = sArr(i, k + 2)
Next k
Case Is = 5
s5 = s5 + 1
Arr05(s5, 1) = s5 'soTT
For k = 2 To 10
Arr05(s5, k) = sArr(i, k + 2)
Next k
End Select

End If
Next i
With Sheets("BanRa")
If s1 Then
.Cells(18, "B").Resize(s1, 10) = Arr01
End If
If s2 Then
.Cells(121, "B").Resize(s2, 10) = Arr02
End If
If s3 Then
.Cells(224, "B").Resize(s3, 10) = Arr03
End If
If s4 Then
.Cells(327, "B").Resize(s4, 10) = Arr04
End If
If s2 Then
.Cells(530, "B").Resize(s5, 10) = Arr05
End If
.Rows(18 + s1 & ":118").EntireRow.Hidden = True
.Rows(121 + s2 & ":221").EntireRow.Hidden = True
.Rows(224 + s3 & ":324").EntireRow.Hidden = True
.Rows(327 + s4 & ":527").EntireRow.Hidden = True
.Rows(530 + s5 & ":580").EntireRow.Hidden = True
End With

Erase sArr, Arr01, Arr02, Arr03, Arr04, Arr05
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With

End Sub

Dùng code sau có vẻ pro hơn
Góp ý, thay vì 18 -> 118, … 530 -580 thì mình cho khoản là 200 mỗi nhóm = nhau cho dễ rút gọn code gán xuống. Đàng nào cũng Hide.
Sub TaoBK01()
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Dim eR&, i&, k&, iM&, iNhom&
Dim sArr, rArr(1 To 100, 1 To 10, 1 To 5), ArrNh(1 To 5)
Dim tArr(1 To 100, 1 To 10)
With Sheets("BanRa")
iM = .
.Rows("18:580").EntireRow.Hidden = False
.Range("B18:K118").ClearContents
.Range("B121:K221").ClearContents
.Range("B224:K324").ClearContents
.Range("B327:K527").ClearContents
.Range("B530:K580").ClearContents
End With
With Sheets("NhapBan")
eR = .Cells(65000, "E").End(xlUp).Row
sArr = .Range("A18:L" & eR).Value
End With
For i = 1 To UBound(sArr)
If CLng(sArr(i, 1)) = iM Then
iNhom = sArr(i, 2)
ArrNh(iNhom) = ArrNh(iNhom) + 1
rArr(ArrNh(iNhom), 1, iNhom) = ArrNh(iNhom)
For k = 2 To 10
rArr(ArrNh(iNhom), k, iNhom) = sArr(i, k + 2)
Next k
End If
Next i
For iNhom = 1 To 5
For i = 1 To UBound(ArrNh)
For k = 1 To 10
tArr(i, k) = rArr(i, k, iNhom)
Next k
Next i
With Sheets("BanRa")
If ArrNh(iNhom) Then
Select Case iNhom
Case Is = 1
.Cells(18, "B").Resize(ArrNh(iNhom), 10) = tArr
.Rows(18 + ArrNh(iNhom) & ":118").EntireRow.Hidden = True
Case Is = 2
.Cells(121, "B").Resize(ArrNh(iNhom), 10) = tArr
.Rows(121 + ArrNh(iNhom) & ":221").EntireRow.Hidden = True
Case Is = 3
.Cells(224, "B").Resize(ArrNh(iNhom), 10) = tArr
.Rows(224 + ArrNh(iNhom) & ":324").EntireRow.Hidden = True
Case Is = 4
.Cells(327, "B").Resize(ArrNh(iNhom), 10) = tArr
.Rows(327 + ArrNh(iNhom) & ":527").EntireRow.Hidden = True
Case Is = 5
.Cells(530, "B").Resize(ArrNh(iNhom), 10) = tArr
.Rows(530 + ArrNh(iNhom) & ":580").EntireRow.Hidden = True
End Select
End If
End With
Next iNhom
Erase sArr, rArr, tArr
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With

End Sub

www.giaiphapexcel.com/diendan/threads/gi%C3%BAp-code-l%E1%BB%8Dc-theo-th%C3%A1ng-nh%C3%B3m-sau-%C4%91%C3%B3-paste-c%C3%A1c-nh%C3%B3m-tr%C3%AAn-c%C3%B9ng-m%E1%BB%99t-b%E1%BA%A3ng-t%C3%ADnh.71098/

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học

Chia sẻ: