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

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
121
Được thích
21
Điểm
370
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

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,869
Được thích
6,064
Điểm
560
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
121
Được thích
21
Điểm
370
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

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
121
Được thích
21
Điểm
370
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.
 

Ai_Ma_Biet

Thành viên hoạt động
Tham gia ngày
22 Tháng tư 2015
Bài viết
121
Được thích
21
Điểm
370
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
121
Được thích
21
Điểm
370
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
121
Được thích
21
Điểm
370
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.
 
Top Bottom