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! (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Hong.Van

Hong.Van

Busy
Tham gia
7/5/12
Bài viết
2,330
Được thích
1,767
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!
----------
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Hong.Van đã viết:
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!
----------
Nhấp chuột vào đây để mở rộng...
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ế à.
 
Upvote 0
ThuNghi đã viết:
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ế à.
Nhấp chuột vào đây để mở rộng...

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!
 
Upvote 0
Hong.Van đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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.
PHP: 
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 = .[G7]
  .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.
PHP: 
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 = .[G7]
  .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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hong.Van đã viết:
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!
Nhấp chuột vào đây để mở rộng...
Dữ liệu bố trí lạ nhỉ? Từ nhóm 1 đến nhóm 3 đều 100 dòng... tự nhiên lại lòi ra thằng em nhóm 4 có 200 dòng và nhóm 5 có 50 dòng ---> Chỉ tổ gây rối và khiến code dài ra thêm và thiếu tính nhất quán
Ngoài ra: Không biết ẩn dòng đê làm giống gì nữa? Sao không đặt kết quả "nối đuôi" nhau?
 
Upvote 0
ndu96081631 đã viết:
Dữ liệu bố trí lạ nhỉ? Từ nhóm 1 đến nhóm 3 đều 100 dòng... tự nhiên lại lòi ra thằng em nhóm 4 có 200 dòng và nhóm 5 có 50 dòng ---> Chỉ tổ gây rối và khiến code dài ra thêm và thiếu tính nhất quán
Ngoài ra: Không biết ẩn dòng đê làm giống gì nữa? Sao không đặt kết quả "nối đuôi" nhau?
Nhấp chuột vào đây để mở rộng...

1/ Các nhóm thường fát sinh nhiều thì em cho nhiều dòng
2/ Dĩ nhiên em muốn các nhóm là liên tục khỏi ẩn dòng thì sẽ đẹp hơn, nhưng như vậy code sẽ thêm các dòng tiêu đề và thêm tổng cộng của mỗi nhóm --> Đòi hỏi nhiều quá em ngại!
Em xin cảm ơn Thầy cô & anh chị đã giúp đỡ.
 
Upvote 0
Hong.Van đã viết:
1/ Các nhóm thường fát sinh nhiều thì em cho nhiều dòng
2/ Dĩ nhiên em muốn các nhóm là liên tục khỏi ẩn dòng thì sẽ đẹp hơn, nhưng như vậy code sẽ thêm các dòng tiêu đề và thêm tổng cộng của mỗi nhóm --> Đòi hỏi nhiều quá em ngại!
Em xin cảm ơn Thầy cô & anh chị đã giúp đỡ.
Nhấp chuột vào đây để mở rộng...
Cũng chưa chắc cái nào dễ hơn cái nào đâu. Tiêu đề thì tiêu đề, cùng lắm cho nó vào 1 name rồi lôi ra gán xuống sheet ---> Quá dễ
Bạn tự suy nghĩ trước xem (tôi nghĩ bài này không đến nỗi khó so với trình độ của bạn)
Ẹc... Ẹc...
 
Upvote 0
Hong.Van đã viết:
1/ Các nhóm thường fát sinh nhiều thì em cho nhiều dòng
2/ Dĩ nhiên em muốn các nhóm là liên tục khỏi ẩn dòng thì sẽ đẹp hơn, nhưng như vậy code sẽ thêm các dòng tiêu đề và thêm tổng cộng của mỗi nhóm --> Đòi hỏi nhiều quá em ngại!
Em xin cảm ơn Thầy cô & anh chị đã giúp đỡ.
Nhấp chuột vào đây để mở rộng...

Khi đó dùng Outline Group, SUbtotal còn tiện hơn đó bạn ơi,
dĩ nhiên là phải xem kỹ chút lại DL, và bạn nên gửi luôn yêu cầu và đầy đủ cái điều mình muốn như thế đỡ phải hỏi đi hỏi lại
 
Upvote 0
Xem qua code của ThuNghi trên, thì bạn lưu ý là chưa đề cập đến THÁNG ở cell G7 sheet ban ra thì phải,

bạn thử xem
 
Upvote 0
Hong.Van đã viết:
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!
----------
Nhấp chuột vào đây để mở rộng...

Xem phương án này nhé, nếu thích hợp thì sửa sơ sơ lại vùng N4 đến N10
Tính viết thêm tí nữa cho code đẹp nhưng lười quá
 

File đính kèm

Upvote 0
quanghai1969 đã viết:
Xem phương án này nhé, nếu thích hợp thì sửa sơ sơ lại vùng N4 đến N10
Tính viết thêm tí nữa cho code đẹp nhưng lười quá
Nhấp chuột vào đây để mở rộng...

Làm như Hải thì sẽ phải thêm nhiều vòng duyệt qua nhóm.
Nên làm 1 arr 3 chiều thì tốt hơn.
Thú thật làm nối đuôi thì mệt nhất là phần format
PHP: 
Sub TaoBK01()
Const RowEnd = 1000
With Application
  .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Dim eR&, i&, k&, iM&, iNhom&, nR&
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 = .[G7]
  .Range("B18:K" & RowEnd).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
        .Cells(18 + nR, "B").Resize(ArrNh(iNhom), 10) = tArr
        .Cells(18 + nR + ArrNh(iNhom) + 1, "B") = "Tong"
        With .Cells(18 + nR + ArrNh(iNhom) + 1, "I").Resize(, 2)
            .FormulaR1C1 = "=SUBTOTAL(9,R[-" & ArrNh(iNhom) + 1 & "]C:R[-1]C)"
        End With
        .Cells(18 + nR + ArrNh(iNhom) + 2, "B") = Sheets("TmpHeader").Range("A" & iNhom)
        nR = nR + ArrNh(iNhom) + 3
      End If
    End With
Next iNhom
Erase sArr, rArr, tArr
With Application
  .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With

End Sub
Nhấp chuột vào đây để mở rộng...
Thêm sh TmpHeader để lấy tiêu đề, làm biếng tìm mã cho mấy từ tiếng Việt. Mai làm lại cho bài bản.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
quanghai1969 đã viết:
Xem phương án này nhé, nếu thích hợp thì sửa sơ sơ lại vùng N4 đến N10
Tính viết thêm tí nữa cho code đẹp nhưng lười quá
Nhấp chuột vào đây để mở rộng...

Em cảm ơn anh đã giúp.
Anh giúp em thêm 1 tý nữa về định dạng Format ở sheet BanRa (Giống như Sheet NhapBan) như sau:
1/ Cột E (ngày tháng) là: dd/mm/yyyy
2/ Cột G (Mã số thuế người mua) : đây là dạng Text (Ở sheet BanRa mất hết các số 0 đầu tiên!)
3/ Cột I & J định dạng & một số cell khác, định dạng số tiền có fân cách hàng ngàn (VD: 1.234.000)
4/ Các tiêu đề bắt đầu từ cột B chứ kg fải cột C
5/ Các tiêu đề & Tong, anh Bold lên giùm em
6/ Khi chạy code thì đừng xóa định dạng
7/ Nếu có thể thì cho em thêm 1 dòng trống fía trên liền kề với những hàng có chữ Tong
------------
Vì những việc trên có liên quan đến việc Add báo cáo này vào Phần mềm của Tổng cục thuế được (Định dạng không đúng thì phần mềm thuế kg cho Add hoặc bị sai)
Em cảm ơn!
 
Upvote 0
ThuNghi đã viết:
Làm như Hải thì sẽ phải thêm nhiều vòng duyệt qua nhóm.
Nên làm 1 arr 3 chiều thì tốt hơn.
Nhấp chuột vào đây để mở rộng...

Em viết được như vậy là hết rồi, anh biết khả năng em chỉ có tới đó. Code không đẹp nhưng có thể xử được công việc. Đôi lúc phải dùng tà đạo tí
 
Upvote 0
Hong.Van đã viết:
Em cảm ơn anh đã giúp.
Anh giúp em thêm 1 tý nữa về định dạng Format ở sheet BanRa (Giống như Sheet NhapBan) như sau:
1/ Cột E (ngày tháng) là: dd/mm/yyyy
2/ Cột G (Mã số thuế người mua) : đây là dạng Text (Ở sheet BanRa mất hết các số 0 đầu tiên!)
3/ Cột I & J định dạng & một số cell khác, định dạng số tiền có fân cách hàng ngàn (VD: 1.234.000)
4/ Các tiêu đề bắt đầu từ cột B chứ kg fải cột C
5/ Các tiêu đề & Tong, anh Bold lên giùm em
6/ Khi chạy code thì đừng xóa định dạng
7/ Nếu có thể thì cho em thêm 1 dòng trống fía trên liền kề với những hàng có chữ Tong
------------
Vì những việc trên có liên quan đến việc Add báo cáo này vào Phần mềm của Tổng cục thuế được (Định dạng không đúng thì phần mềm thuế kg cho Add hoặc bị sai)
Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
1/ Chỉ cần cột ngày l2 dd/mm/yyyy là OK rồi.
2/ Phần bold cũng kg cần khi import vào HTKK đâu.
3/ Thêm dòng trong dưới tổng thì sửa code như sau
PHP: 
 .Cells(18 + nR + ArrNh(iNhom) + 2, "B") = Sheets("TmpHeader").Range("A" & iNhom)
        nR = nR + ArrNh(iNhom) + 3
Sửa số 2 thành 3 và 3 thành 4 (+1)
Đúng ra kg cần dùng sh Tmp vì mấy câu 1.... có thể dùng VBA viết luôn, bạn thử dùng câu trên bằng TV kg dấu thử xem, hình như import cũng OK. Ở nhà kg có HTKK để test.
Nên làm riêng cho BanRa và MuaVao riêng, 2 form có khác nhau đó.
Sao kg lấy file trên là dữ liệu thô, còn khi import thì copy vào và import thì hay hơn. File để import luôn trống.
Còn file đang thực thi thì chỉ là kết xuất.
 
Upvote 0
ThuNghi đã viết:
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.
PHP: 
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 = .[G7]
  .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
Nhấp chuột vào đây để mở rộng...
Em thấy chạy code này, mỗi tiêu đề nó chỉ lọc được 5 dòng
Mặt khác, tiêu đề nào khg có thì nó không Hide dòng
-------
Thầy xem lại giúp em
Em cảm ơn
 

File đính kèm

Upvote 0
Hong.Van đã viết:
Em thấy chạy code này, mỗi tiêu đề nó chỉ lọc được 5 dòng
Mặt khác, tiêu đề nào khg có thì nó không Hide dòng
-------
Thầy xem lại giúp em
Em cảm ơn
Nhấp chuột vào đây để mở rộng...
Sorry! Do sai ở câu code sau:
PHP: 
For i = 1 To UBound(ArrNh)
Sửa thành
PHP: 
For i = 1 To ArrNh(iNhom)
Và TH kg hide dòng thì tách phần If ArrNh(iNhom) Then thành 2 select case.
PHP: 
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 = .[G7]
  .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 ArrNh(iNhom)
    For k = 1 To 10
      tArr(i, k) = rArr(i, k, iNhom)
    Next k
  Next i
  With Sheets("BanRa")
      'Gan so lieu
      If ArrNh(iNhom) Then
        Select Case iNhom
          Case Is = 1
            .Cells(18, "B").Resize(ArrNh(iNhom), 10) = tArr
          Case Is = 2
            .Cells(121, "B").Resize(ArrNh(iNhom), 10) = tArr
          Case Is = 3
            .Cells(224, "B").Resize(ArrNh(iNhom), 10) = tArr
          Case Is = 4
            .Cells(327, "B").Resize(ArrNh(iNhom), 10) = tArr
          Case Is = 5
            .Cells(530, "B").Resize(ArrNh(iNhom), 10) = tArr
        End Select
      End If
      'Hide dong
      Select Case iNhom
          Case Is = 1
            .Rows(18 + ArrNh(iNhom) & ":118").EntireRow.Hidden = True
          Case Is = 2
            .Rows(121 + ArrNh(iNhom) & ":221").EntireRow.Hidden = True
          Case Is = 3
            .Rows(224 + ArrNh(iNhom) & ":324").EntireRow.Hidden = True
          Case Is = 4
            .Rows(327 + ArrNh(iNhom) & ":527").EntireRow.Hidden = True
          Case Is = 5
            .Rows(530 + ArrNh(iNhom) & ":580").EntireRow.Hidden = True
        End Select
    End With
Next iNhom
Erase sArr, rArr, tArr
With Application
  .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With

End Sub
Hình như nhom 1 với 100 dòng kg đủ nên hide bớt 1 dòng bị lỗi.
 
Upvote 0
Hong.Van đã viết:
Em cảm ơn anh đã giúp.
Anh giúp em thêm 1 tý nữa về định dạng Format ở sheet BanRa (Giống như Sheet NhapBan) như sau:
1/ Cột E (ngày tháng) là: dd/mm/yyyy
2/ Cột G (Mã số thuế người mua) : đây là dạng Text (Ở sheet BanRa mất hết các số 0 đầu tiên!)
3/ Cột I & J định dạng & một số cell khác, định dạng số tiền có fân cách hàng ngàn (VD: 1.234.000)
4/ Các tiêu đề bắt đầu từ cột B chứ kg fải cột C
5/ Các tiêu đề & Tong, anh Bold lên giùm em
6/ Khi chạy code thì đừng xóa định dạng
7/ Nếu có thể thì cho em thêm 1 dòng trống fía trên liền kề với những hàng có chữ Tong
------------
Vì những việc trên có liên quan đến việc Add báo cáo này vào Phần mềm của Tổng cục thuế được (Định dạng không đúng thì phần mềm thuế kg cho Add hoặc bị sai)
Em cảm ơn!
Nhấp chuột vào đây để mở rộng...

Bạn xem file đính kèm, chắc là được đấy
 

File đính kèm

Upvote 0
Rảnh quá làm chơi cái coi
1> Thêm 1 hàm để hổ trợ nhập liệu tiếng Việt:
PHP: 
Function UniConvert(ByVal Text As String, ByVal InputMethod As String) As String
  Dim VNI_Type, Telex_Type, CharCode, Temp, i As Long
  UniConvert = Text
  VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
      "e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
      "o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
      "e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
      "o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")
  Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
      "eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
      "owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
      "es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
      "oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
      ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
      ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
      ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
      ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
      ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
      ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
      ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  Select Case InputMethod
    Case Is = "VNI": Temp = VNI_Type
    Case Is = "Telex": Temp = Telex_Type
  End Select
  For i = 0 To UBound(CharCode)
    UniConvert = Replace(UniConvert, Temp(i), CharCode(i))
    UniConvert = Replace(UniConvert, UCase(Temp(i)), UCase(CharCode(i)))
  Next i
End Function
2> Code chính:
PHP: 
Sub Main()
  Dim wksSrc As Worksheet, wksDes As Worksheet
  Dim aParent(1 To 5, 1 To 5), aChild(1 To 200, 1 To 10), sArray
  Dim Crit As Long, lR As Long, lC As Long, n As Long, lGrp As Long, i As Long, tmp As Long
  Dim dTotal1 As Double, dTotal2 As Double
  Dim s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, s
  Dim s6 As String, s7 As String
  Application.ScreenUpdating = False
  On Error Resume Next
  Set wksSrc = Sheets("NhapBan")
  Set wksDes = Sheets("BanRa")
  s1 = UniConvert("Hàng hóa, di5ch vu5 không chi5u thue61 GTGT:", "VNI")
  s2 = UniConvert("Hàng hóa, di5ch vu5 chi5u thue61 sua61t thue61 GTGT 0%:", "VNI")
  s3 = UniConvert("Hàng hóa, di5ch vu5 chi5u thue61 sua61t thue61 GTGT 5%:", "VNI")
  s4 = UniConvert("Hàng hóa, di5ch vu5 chi5u thue61 sua61t thue61 GTGT 10%:", "VNI")
  s5 = UniConvert("Hàng hóa, di5ch vu5 không pha3i to63ng ho75p trên to72 khai 01/GTGT:", "VNI")
  s6 = UniConvert("To63ng doanh thu hàng hóa, di5ch vu5 bán ra:", "VNI")
  s7 = UniConvert("To63ng thue61 GTGT cu3a hàng hóa, di5ch vu5 bán ra:", "VNI")
  s = Array(s1, s2, s3, s4, s5)
  Crit = wksDes.Range("G7").Value
  wksDes.Range("B17:K1000").ClearContents
  If Crit < 1 Or Crit > 12 Then Exit Sub
  For i = 1 To 5
    aParent(i, 1) = aChild
    aParent(i, 5) = s(i - 1)
  Next
  sArray = wksSrc.Range("A18:L20000").Value
  For lR = 1 To UBound(sArray, 1)
    If sArray(lR, 1) = Crit Then
      lGrp = sArray(lR, 2)
      If lGrp > 0 And lGrp < 6 Then
        n = aParent(lGrp, 2) + 1
        aParent(lGrp, 2) = n
        aParent(lGrp, 1)(n, 1) = n
        For lC = 2 To 10
          If lC = 3 Then
            aParent(lGrp, 1)(n, lC) = "'" & Format(sArray(lR, lC + 2), "0000000")
          ElseIf lC = 6 Then
            aParent(lGrp, 1)(n, lC) = "'" & Format(sArray(lR, lC + 2), "0000000000")
          Else
            aParent(lGrp, 1)(n, lC) = sArray(lR, lC + 2)
          End If
        Next
        aParent(lGrp, 3) = aParent(lGrp, 3) + aParent(lGrp, 1)(n, 8)
        aParent(lGrp, 4) = aParent(lGrp, 4) + aParent(lGrp, 1)(n, 9)
      End If
    End If
  Next
  n = 0
  With wksDes
    For i = 1 To 5
      tmp = aParent(i, 2)
      If tmp > 0 Then
        .Range("B17").Offset(n).Value = i & ". " & aParent(i, 5)
        .Range("B17:K17").Offset(n + 1).Resize(tmp).Value = aParent(i, 1)
        .Range("B17").Offset(n + tmp + 1).Value = UniConvert("To63ng:", "VNI")
        .Range("B17").Offset(n + tmp + 1, 7).Value = aParent(i, 3)
        .Range("B17").Offset(n + tmp + 1, 8).Value = aParent(i, 4)
        If i < 5 Then dTotal1 = dTotal1 + aParent(i, 3)
        If i < 5 Then dTotal2 = dTotal2 + aParent(i, 4)
        n = n + tmp + 3
      End If
    Next
    If n Then
      With .Range("B17").Offset(n)
        .Value = s6
        .Font.Bold = True
      End With
      With .Range("B17").Offset(n + 1)
        .Value = s7
        .Font.Bold = True
      End With
      With .Range("B17").Offset(n, 4)
        .Value = dTotal1
        .NumberFormat = "#,##0"
        .Font.Bold = True
      End With
      With .Range("B17").Offset(n + 1, 4)
        .Value = dTotal2
        .NumberFormat = "#,##0"
        .Font.Bold = True
      End With
    End If
  End With
  Application.ScreenUpdating = True
End Sub
3> Code sự kiện Change:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$G$7" Then Main
End Sub
Trong file có dùng 1 ít Conditional Formating ---> Xem thử, nếu không vừa ý thì tự chỉnh lại
 

File đính kèm

Upvote 0
ndu96081631 đã viết:
Rảnh quá làm chơi cái coi
2> Code chính:
PHP: 
Sub Main()
  Dim wksSrc As Worksheet, wksDes As Worksheet
  Dim aParent(1 To 5, 1 To 5), aChild(1 To 200, 1 To 10), sArray
Nhấp chuột vào đây để mở rộng...
Rất hay arr mẹ và arr con. Cám ơn NDU nhiều.
Tôi đang thắc mắc liệu dùng Arr mẹ con và arr 3 chiều thì cái nào sẽ tối ưu hơn.
1/ Arr mẹ con thì kg cần duyệt lại mà gán thẳng xuống sh
2/ Arr 3 chiều thì phải duyệt qua 1 lần nữa rồi mới lấy Arr 2 chiều rồi gán xuống Arr.
 
Upvote 0
ThuNghi đã viết:
Rất hay arr mẹ và arr con. Cám ơn NDU nhiều.
Tôi đang thắc mắc liệu dùng Arr mẹ con và arr 3 chiều thì cái nào sẽ tối ưu hơn.
1/ Arr mẹ con thì kg cần duyệt lại mà gán thẳng xuống sh
2/ Arr 3 chiều thì phải duyệt qua 1 lần nữa rồi mới lấy Arr 2 chiều rồi gán xuống Arr.
Nhấp chuột vào đây để mở rộng...

Mình nghĩ nhanh hay chậm là do quá trình tính toán ---> Tức số lượng các phép tính là nhiều hay ít chứ có lẽ không liên quan đến mảng mấy chiều đâu
(đương nhiên cũng phải xét đến số lượng phần tử của mảng nhiều hay ít nữa)
Nói chung là: Thí nghiệm sẽ biết
Ẹc... Ẹc...
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711) (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
264
Đọc
28K
lilknighthood
L
PhanTuHuong
Nên chọn điện thoại nào? (1 người xem)
2
Trả lời
20
Đọc
1K
dungluyen2119
dungluyen2119
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :) (1 người xem)
    • Thích
    • Yêu thích
Trả lời
9
Đọc
390
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Manhhung90
Tạo nút bấm để xoá nhanh trang trong file word.
Trả lời
3
Đọc
89
PhanTuHuong
PhanTuHuong
H
Hàm Evaluate bị lỗi khi mở lại
2
Trả lời
23
Đọc
284
ptm0412
ptm0412
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Buồn
    • Cười
Trả lời
5
Đọc
217
SA_DQ
SA_DQ
Nguyễn Duy Tuân
Lập trình VBA với Google Drive, OneDrive, DropBox cho Upload-Download-Copy-Move...
    • Cảm ơn
    • Thích
Trả lời
4
Đọc
305
quyenpv
quyenpv
hungmanh.th1
Lỗi không trả về Giá trị 0 trong excel (1 người xem)
    • Cười
Trả lời
5
Đọc
73
hungmanh.th1
hungmanh.th1
HeSanbi
  • Question Question
VBA nâng cao: Nhúng tập tin vào trang tính hoặc trích xuất chúng nhanh chóng (1 người xem)
    • Thích
    • Cảm ơn
Trả lời
0
Đọc
129
HeSanbi
HeSanbi
nguyễn tiến tú
file CALCULATING rất chậm em nhờ các anh chị xem giúp em ạ (1 người xem)
Trả lời
7
Đọc
383
tranhungdao12a3
T
T
  • Question Question
Xin thầy/cô và anh chị giúp đỡ cách điền thông tin ca kíp trực trong bảng Excel bằng VBA
Trả lời
2
Đọc
152
tiennd67
T
vnxgiokinhtoi
Nhờ giúp đỡ công thức lưu dữ liệu và mở lại dữ liệu cũ đã save (1 người xem)
Trả lời
2
Đọc
107
le_vis
L
H
HELP! HÀM LẤY THÁNG/ NĂM TRONG EXCEL
Trả lời
5
Đọc
130
ptm0412
ptm0412
H
Em hỏi vì sao khi file googlesheet của em thì code chạy
Trả lời
2
Đọc
59
Hoale85
H
4
EXCEL TỰ ĐỘNG MỞ TRÊN WEB
Trả lời
9
Đọc
275
4545
4
T
Nhờ ACE chỉ giáo công thức Gộp nhiều dữ liệu vào một ô trong excel (1 người xem)
Trả lời
9
Đọc
234
Hoàng Tuấn 868
H
H
Phân quyền xem trên từng trang tính của googlesheet
Trả lời
6
Đọc
149
tranhungdao12a3
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
2 3
Trả lời
50
Đọc
14K
HeSanbi
HeSanbi
GPE-Trợ Lý
CHÚC MỪNG NGÀY QUỐC TẾ PHỤ NỮ 08/03/2025
    • Yêu thích
    • Thích
Trả lời
0
Đọc
59
GPE-Trợ Lý
GPE-Trợ Lý
M
  • Question Question
Tự chèn dòng khi cập nhật dữ liệu từ trang tính khác.
Trả lời
6
Đọc
286
hoangtuan.net
hoangtuan.net
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom