Xuất dữ liệu theo nhiều điều kiện

Quảng cáo

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
128
Được thích
22
Điểm
318
Nơi ở
Bến Lức Long An
Chào Anh, Chị.

Mình có file Excel cần xuất ra nhiều file Excel theo điều kiện bên dưới. Nhờ Anh, Chị viết code giúp cho 2 trường hợp như bên dưới:

Mình có xuất thử mỗi loại 2 file như bên dưới
Cách 1: file Bang ke-50dao.xlsx và file Bang ke-50san.xlsx
Cách 2: file Bang ke-50lac.xlsx và file Bang ke-60cuong.xlsx

1602572154604.png

Cám ơn Anh, Chị
 

File đính kèm

  • Xuat file excel theo dieu kien.xlsx
    342.1 KB · Đọc: 11
  • Bang ke-50dao.xlsx
    17.7 KB · Đọc: 1
  • Bang ke-50lac.xlsx
    17 KB · Đọc: 2
  • Bang ke-60CUONG.xlsx
    15.4 KB · Đọc: 0
  • Bang ke-50san.xlsx
    16.9 KB · Đọc: 0
Lần chỉnh sửa cuối:

bebo021999

Thành viên gạo cội
Tham gia ngày
26 Tháng một 2011
Bài viết
3,966
Được thích
6,180
Điểm
2,868
Nơi ở
TPHCM, Gò Vấp
Kết quả xuất ra nằm ở đâu, cụ thể thế nào, bạn điền 1 vài dòng mẫu nhé
 

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
128
Được thích
22
Điểm
318
Nơi ở
Bến Lức Long An
Kết quả xuất ra nằm ở đâu, cụ thể thế nào, bạn điền 1 vài dòng mẫu nhé
Xuất ra nằm chung folder đó luôn nha bạn.

Mình có xuất thử mỗi loại 2 file như bên dưới
Cách 1: file Bang ke-50dao.xlsx và file Bang ke-50san.xlsx
Cách 2: file Bang ke-50lac.xlsx và file Bang ke-60cuong.xlsx
 

File đính kèm

  • Bang ke-50dao.xlsx
    17.7 KB · Đọc: 4
  • Bang ke-50lac.xlsx
    17 KB · Đọc: 4
  • Bang ke-60CUONG.xlsx
    15.4 KB · Đọc: 1
  • Bang ke-50san.xlsx
    16.9 KB · Đọc: 1

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
128
Được thích
22
Điểm
318
Nơi ở
Bến Lức Long An
Chào Anh, Chị.

Mình có file Excel cần xuất ra nhiều file Excel theo điều kiện bên dưới. Nhờ Anh, Chị viết code giúp cho 2 trường hợp như bên dưới:

Mình có xuất thử mỗi loại 2 file như bên dưới
Cách 1: file Bang ke-50dao.xlsx và file Bang ke-50san.xlsx
Cách 2: file Bang ke-50lac.xlsx và file Bang ke-60cuong.xlsx

View attachment 247331

Cám ơn Anh, Chị
Anh, Chị giúp mình với.
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
8,019
Được thích
9,374
Điểm
3,168
Nơi ở
TP.HCM
File đính kèm là code cho yêu cầu 1. Yêu cầu 2 cũng không khác gì nhiều, bạn nghiên cứu tự làm thử xem.
Tôi có quay lại quá trình làm yêu cầu 1, bạn có thể tham khảo.


 

File đính kèm

  • Xuat file excel theo dieu kien.xlsm
    368.5 KB · Đọc: 13

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
128
Được thích
22
Điểm
318
Nơi ở
Bến Lức Long An
File đính kèm là code cho yêu cầu 1. Yêu cầu 2 cũng không khác gì nhiều, bạn nghiên cứu tự làm thử xem.
Tôi có quay lại quá trình làm yêu cầu 1, bạn có thể tham khảo.


Làm không được bạn ơi, với lại bạn chỉnh giúp mình file xuất ra có format y như file gốc giúp (màu, kích thước các cột).
 

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
128
Được thích
22
Điểm
318
Nơi ở
Bến Lức Long An
File đính kèm là code cho yêu cầu 1. Yêu cầu 2 cũng không khác gì nhiều, bạn nghiên cứu tự làm thử xem.
Tôi có quay lại quá trình làm yêu cầu 1, bạn có thể tham khảo.


Chỗ cách 2 mình sửa như bên dưới nhưng không ra được cột I, vẫn ra cột J
.Range("Q14").Value = .Range("I1").Value

Mã:
With Sheet1
    .Range("O14:P14").Value = .Range("A1").Value
    .Range("Q14").Value = .Range("I1").Value
    .Range("R14").Value = .Range("M1").Value
    .Range("O15").Value = "'>=" & .Range("P2").Value2
    .Range("P15").Value = "'<=" & .Range("Q2").Value2
    .Range("R15").Value = "C" & ChrW(244) & "ng ty"
End With
For i = 2 To UBound(aKH, 1)
    If VBA.IsNumeric(Left(aKH(i, 1), 1)) Then
        Sheet1.Range("Q15").Value = aKH(i, 1)
        Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet1.Range _
            ("O14:R15"), CopyToRange:=TmpSh.Range("A1"), Unique:=False
        sFilename = ThisWorkbook.Path & "\Bang ke GM-" & aKH(i, 1) & ".xlsx"
        If Dir(sFilename) <> "" Then Kill sFilename
 
Lần chỉnh sửa cuối:

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
128
Được thích
22
Điểm
318
Nơi ở
Bến Lức Long An
Chỗ cách 2 mình sửa như bên dưới nhưng không ra được cột I, vẫn ra cột J
.Range("Q14").Value = .Range("I1").Value

Mã:
With Sheet1
    .Range("O14:P14").Value = .Range("A1").Value
    .Range("Q14").Value = .Range("I1").Value
    .Range("R14").Value = .Range("M1").Value
    .Range("O15").Value = "'>=" & .Range("P2").Value2
    .Range("P15").Value = "'<=" & .Range("Q2").Value2
    .Range("R15").Value = "C" & ChrW(244) & "ng ty"
End With
For i = 2 To UBound(aKH, 1)
    If VBA.IsNumeric(Left(aKH(i, 1), 1)) Then
        Sheet1.Range("Q15").Value = aKH(i, 1)
        Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet1.Range _
            ("O14:R15"), CopyToRange:=TmpSh.Range("A1"), Unique:=False
        sFilename = ThisWorkbook.Path & "\Bang ke GM-" & aKH(i, 1) & ".xlsx"
        If Dir(sFilename) <> "" Then Kill sFilename
sửa giúp mình với.
 
Quảng cáo
Top Bottom