dùng VBA lọc dữ liệu theo nhiều điều kiện từ 1 file rồi lấy kết quả dán vào 1 file khác (4 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)
A

alex-luu

Thành viên thường trực
Tham gia
10/3/15
Bài viết
300
Được thích
52
Xin mọi người giúp đỡ ,
Em có 1 file tổng hợp, em muốn tạo 1 nút bấm cập nhật report để khi click vào nó sẽ hiện lên 1 bảng hỏi đường dẫn của file report, mình chỉ đường dẫn tới thì nó sẽ mở file report ra, lọc theo điều kiện như sau, sau khi lọc xong, sẽ copy vài cột dữ liệu trong file report (không copy toàn bộ) và dán qua file tổng hợp.

Hiện nay , trong file tổng hợp, em phải tạo ra 1 sheet report phụ, mỗi khi có report từ văn phòng chính gởi xuống, em copy toàn bộ nguyên sheet, paste qua sheet report phụ, rồi dùng thêm 1 cột phụ để lọc, rồi dùng hàm vlookup để lấy dữ liệu qua sheet tổng hợp. Cách làm này rất thủ công.

Mặt khác do dữ liệu trong file report rất lớn (gần 20.000 hàng) nên file chạy bằng cách này rất nặng và chậm, đôi khi treo máy luôn.

Nhờ mọi người hướng dẫn dùng VBA để file chạy nhanh và nhẹ hơn. Nếu dùng code VBA, em nghĩ có lẽ sẽ không cần dùng thêm 1 sheet report phụ, cũng không cần dùng cách vlookup cho 20.000 hàng và 15 cột.

Điều kiện để lọc :
1 . Nhìn trong file report, cột G (Location), nếu có các chữ sau thì bỏ hàng đó, không lấy : ACE , ATD , BAN , CMD , ZPC
2. Nhìn trong file report, cột B (Status), nếu có chữ Cancelled thì bỏ hàng đó, không lấy.
3. Nhìn trong file report, cột D (Class Type), nếu có chữ AR hoặc UL thì lấy hàng đó, còn lại bỏ hết, không lấy

Sau khi lọc xong, thì chỉ lấy nội dung của các cột :
​
Class ID
Start DateTrainer Code 1Trainer Name 1Trainer 1 No.Session weekdayTrainer 1 No.Session weekendTrainer Code 2Trainer Name 2Trainer 2 No.Session weekdayTrainer 2 No.Session weekendTrainer Code 3Trainer Name 3Trainer 3 No.Session weekdayTrainer 3 No.Session weekend
rồi dán qua sheet tổng hợp.



Em xin cảm ơn
 

File đính kèm

Lần chỉnh sửa cuối:
alex-luu đã viết:
Xin mọi người giúp đỡ ,
Em có 1 file tổng hợp, em muốn tạo 1 nút bấm cập nhật report để khi click vào nó sẽ hiện lên 1 bảng hỏi đường dẫn của file report, mình chỉ đường dẫn tới thì nó sẽ mở file report ra, lọc theo điều kiện như sau, sau khi lọc xong, sẽ copy vài cột dữ liệu trong file report (không copy toàn bộ) và dán qua file tổng hợp.

Hiện nay , trong file tổng hợp, em phải tạo ra 1 sheet report phụ, mỗi khi có report từ văn phòng chính gởi xuống, em copy toàn bộ nguyên sheet, paste qua sheet report phụ, rồi dùng thêm 1 cột phụ để lọc, rồi dùng hàm vlookup để lấy dữ liệu qua sheet tổng hợp. Cách làm này rất thủ công.

Mặt khác do dữ liệu trong file report rất lớn (gần 20.000 hàng) nên file chạy bằng cách này rất nặng và chậm, đôi khi treo máy luôn.

Nhờ mọi người hướng dẫn dùng VBA để file chạy nhanh và nhẹ hơn. Nếu dùng code VBA, em nghĩ có lẽ sẽ không cần dùng thêm 1 sheet report phụ, cũng không cần dùng cách vlookup cho 20.000 hàng và 15 cột.

Điều kiện để lọc :
1 . Nhìn trong file report, cột G (Location), nếu có các chữ sau thì bỏ hàng đó, không lấy : ACE , ATD , BAN , CMD , ZPC
2. Nhìn trong file report, cột B (Status), nếu có chữ Cancelled thì bỏ hàng đó, không lấy.
3. Nhìn trong file report, cột D (Class Type), nếu có chữ AR hoặc UL thì lấy hàng đó, còn lại bỏ hết, không lấy

Sau khi lọc xong, thì chỉ lấy nội dung của các cột :
​
Class ID
Start DateTrainer Code 1Trainer Name 1Trainer 1 No.Session weekdayTrainer 1 No.Session weekendTrainer Code 2Trainer Name 2Trainer 2 No.Session weekdayTrainer 2 No.Session weekendTrainer Code 3Trainer Name 3Trainer 3 No.Session weekdayTrainer 3 No.Session weekend
rồi dán qua sheet tổng hợp.




Em xin cảm ơn
Nhấp chuột vào đây để mở rộng...
Chạy code
Mã: 
Sub GPE()
  Dim cn As Object, rs As Object
  Dim eRow&, Sql$
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("A3:N" & eRow).Clear
  End With
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      Set cn = CreateObject("adodb.connection")
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      Sql = "select f1,f5,f8,f9,f10,f11,f12,f13,f14,f15,f16,f17,f18,f19 from [Page 1$A6:S] " & _
          "where f2 not like ""Cancelled"" and (left(f4,2)= ""AR"" or left(f4,2)= ""UL"") " & _
          "and not (left(f7,3)= ""ACE"" or left(f7,3)= ""ATD"" or left(f7,3)= ""BAN"" or left(f7,3)= ""CMD"" or left(f7,3)= ""ZBC"") "
      Set rs = cn.Execute(Sql)
      If Not rs.EOF Then Sheets("Tong Hop").Range("A3").CopyFromRecordset rs
      rs.Close:      cn.Close
      Set rs = Nothing: Set cn = Nothing
      On Error GoTo 0
    End If
  End With
End Sub
 
HieuCD đã viết:
Chạy code
Mã: 
Sub GPE()
  Dim cn As Object, rs As Object
  Dim eRow&, Sql$
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("A3:N" & eRow).Clear
  End With
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      Set cn = CreateObject("adodb.connection")
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      Sql = "select f1,f5,f8,f9,f10,f11,f12,f13,f14,f15,f16,f17,f18,f19 from [Page 1$A6:S] " & _
          "where f2 not like ""Cancelled"" and (left(f4,2)= ""AR"" or left(f4,2)= ""UL"") " & _
          "and not (left(f7,3)= ""ACE"" or left(f7,3)= ""ATD"" or left(f7,3)= ""BAN"" or left(f7,3)= ""CMD"" or left(f7,3)= ""ZBC"") "
      Set rs = cn.Execute(Sql)
      If Not rs.EOF Then Sheets("Tong Hop").Range("A3").CopyFromRecordset rs
      rs.Close:      cn.Close
      Set rs = Nothing: Set cn = Nothing
      On Error GoTo 0
    End If
  End With
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn anh HieuCD, đúng như ý luôn, mình chỉ chỉnh lại 1 chút xíu nữa thôi là xong (chữ ZPC anh viết nhầm thành ZBC).
 
HieuCD đã viết:
Chạy code
Mã: 
Sub GPE()
  Dim cn As Object, rs As Object
  Dim eRow&, Sql$
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("A3:N" & eRow).Clear
  End With
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      Set cn = CreateObject("adodb.connection")
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      Sql = "select f1,f5,f8,f9,f10,f11,f12,f13,f14,f15,f16,f17,f18,f19 from [Page 1$A6:S] " & _
          "where f2 not like ""Cancelled"" and (left(f4,2)= ""AR"" or left(f4,2)= ""UL"") " & _
          "and not (left(f7,3)= ""ACE"" or left(f7,3)= ""ATD"" or left(f7,3)= ""BAN"" or left(f7,3)= ""CMD"" or left(f7,3)= ""ZBC"") "
      Set rs = cn.Execute(Sql)
      If Not rs.EOF Then Sheets("Tong Hop").Range("A3").CopyFromRecordset rs
      rs.Close:      cn.Close
      Set rs = Nothing: Set cn = Nothing
      On Error GoTo 0
    End If
  End With
End Sub
Nhấp chuột vào đây để mở rộng...

ANH HieuCD ơi, sao mấy cột số liệu ( cột F Trainer 1 No.Session weekday), cột G (Trainer 1 No.Session weekend) ..... sau khi code chạy xong nó trở thành định dạng gì đó mà không phải number, nên mấy công thức sum và sumif của em nó ra kết quả =0 hết.
em nhấp phải định dạng nó lại là number mà nó cũng không có tác dụng anh ơi, giúp em lần nữa với
Cảm ơn anh
 
alex-luu đã viết:
ANH HieuCD ơi, sao mấy cột số liệu ( cột F Trainer 1 No.Session weekday), cột G (Trainer 1 No.Session weekend) ..... sau khi code chạy xong nó trở thành định dạng gì đó mà không phải number, nên mấy công thức sum và sumif của em nó ra kết quả =0 hết.
em nhấp phải định dạng nó lại là number mà nó cũng không có tác dụng anh ơi, giúp em lần nữa với
Cảm ơn anh
Nhấp chuột vào đây để mở rộng...
thêm lệnh chuyển số
Mã: 
Sub GPE()
  Dim cn As Object, rs As Object
  Dim eRow&, Sql$
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("A3:N" & eRow).Clear
  End With
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      Set cn = CreateObject("adodb.connection")
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      Sql = "select f1,f5,f8,f9,f10,f11,f12,f13,f14,f15,f16,f17,f18,f19 from [Page 1$A6:S] " & _
          "where f2 not like ""Cancelled"" and (left(f4,2)= ""AR"" or left(f4,2)= ""UL"") " & _
          "and not (left(f7,3)= ""ACE"" or left(f7,3)= ""ATD"" or left(f7,3)= ""BAN"" or left(f7,3)= ""CMD"" or left(f7,3)= ""ZPC"") "
      Set rs = cn.Execute(Sql)
      If Not rs.EOF Then Sheets("Tong Hop").Range("A3").CopyFromRecordset rs
      rs.Close:      cn.Close
      Set rs = Nothing: Set cn = Nothing
      On Error GoTo 0
    End If
  End With
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then
      .Range("E3:F" & eRow).Value = .Range("E3:F" & eRow).Value
      .Range("I3:J" & eRow).Value = .Range("I3:J" & eRow).Value
      .Range("M3:N" & eRow).Value = .Range("M3:N" & eRow).Value
    End If
  End With
End Sub
 
HieuCD đã viết:
thêm lệnh chuyển số
...
Nhấp chuột vào đây để mở rộng...
Khi gặp 1 dãy chuỗi để so sánh như thế thì nên dùng toán tử IN cho SQL

includeList = " (""AR"", ""UL"" ) "
excludeList = " (""ACE"", ""ATD"", ""BAN"", ....) "
' chú ý hai dấu cách trước và sau dãy chuỗi. Thông thường, khi viết SQL động người ta lập khoảng cách an toàn bằng cách thêm dấu cách trước và sau mỗi đoạn chuỗi. Về sau khi nối chuỗi, chỉnh sửa chuỗi sẽ tránh được nhiều lỗi.

Trong câu lệnh SQL:
" Where f2 Not Like ""%Cancelled%"" " & _
" And Left(F4, 2) IN " & includeList & _
" And Left(F7, 3) NOT IN " & excludeList
 
VetMini đã viết:
Khi gặp 1 dãy chuỗi để so sánh như thế thì nên dùng toán tử IN cho SQL

includeList = " (""AR"", ""UL"" ) "
excludeList = " (""ACE"", ""ATD"", ""BAN"", ....) "
' chú ý hai dấu cách trước và sau dãy chuỗi. Thông thường, khi viết SQL động người ta lập khoảng cách an toàn bằng cách thêm dấu cách trước và sau mỗi đoạn chuỗi. Về sau khi nối chuỗi, chỉnh sửa chuỗi sẽ tránh được nhiều lỗi.

Trong câu lệnh SQL:
" Where f2 Not Like ""%Cancelled%"" " & _
" And Left(F4, 2) IN " & includeList & _
" And Left(F7, 3) NOT IN " & excludeList
Nhấp chuột vào đây để mở rộng...
Mấy năm nay không dùng các lệnh LIKE, IN, EXIST nên chỉ nhớ mang máng :( , bạn nhắc mới nhớ lại
 
alex-luu đã viết:
ANH HieuCD ơi, sao mấy cột số liệu ( cột F Trainer 1 No.Session weekday), cột G (Trainer 1 No.Session weekend) ..... sau khi code chạy xong nó trở thành định dạng gì đó mà không phải number, nên mấy công thức sum và sumif của em nó ra kết quả =0 hết.
em nhấp phải định dạng nó lại là number mà nó cũng không có tác dụng anh ơi, giúp em lần nữa với
Cảm ơn anh
Nhấp chuột vào đây để mở rộng...
Chỉnh lại code theo gợi ý của bạn @VetMini
Mã: 
Sub GPE()
  Dim cn As Object, rs As Object
  Dim eRow&, includeList$, excludeList$, Sql$
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("A3:N" & eRow).Clear
  End With
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      Set cn = CreateObject("adodb.connection")
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      includeList = " (""AR"", ""UL"") "
      excludeList = " (""ACE"", ""ATD"", ""BAN"", ""CMD"", ""ZPC"") "
      Sql = "select f1,f5,f8,f9,f10,f11,f12,f13,f14,f15,f16,f17,f18,f19 from [Page 1$A6:S] " & _
            " where f2 not like ""%Cancelled%"" and left(f4,2) in " & includeList & " and left(f7,3) not in " & excludeList
      Set rs = cn.Execute(Sql)
      If Not rs.EOF Then Sheets("Tong Hop").Range("A3").CopyFromRecordset rs
      rs.Close:      cn.Close
      Set rs = Nothing: Set cn = Nothing
      On Error GoTo 0
    End If
  End With
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then
      .Range("E3:F" & eRow).Value = .Range("E3:F" & eRow).Value
      .Range("I3:J" & eRow).Value = .Range("I3:J" & eRow).Value
      .Range("M3:N" & eRow).Value = .Range("M3:N" & eRow).Value
    End If
  End With
End Sub
 
HieuCD đã viết:
Chỉnh lại code theo gợi ý của bạn @VetMini
Mã: 
Sub GPE()
  Dim cn As Object, rs As Object
  Dim eRow&, includeList$, excludeList$, Sql$
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then .Range("A3:N" & eRow).Clear
  End With
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "All Excel", "*.xls*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count Then
      On Error Resume Next
      Set cn = CreateObject("adodb.connection")
      cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(1) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
      includeList = " (""AR"", ""UL"") "
      excludeList = " (""ACE"", ""ATD"", ""BAN"", ""CMD"", ""ZPC"") "
      Sql = "select f1,f5,f8,f9,f10,f11,f12,f13,f14,f15,f16,f17,f18,f19 from [Page 1$A6:S] " & _
            " where f2 not like ""%Cancelled%"" and left(f4,2) in " & includeList & " and left(f7,3) not in " & excludeList
      Set rs = cn.Execute(Sql)
      If Not rs.EOF Then Sheets("Tong Hop").Range("A3").CopyFromRecordset rs
      rs.Close:      cn.Close
      Set rs = Nothing: Set cn = Nothing
      On Error GoTo 0
    End If
  End With
  With Sheets("Tong Hop")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 2 Then
      .Range("E3:F" & eRow).Value = .Range("E3:F" & eRow).Value
      .Range("I3:J" & eRow).Value = .Range("I3:J" & eRow).Value
      .Range("M3:N" & eRow).Value = .Range("M3:N" & eRow).Value
    End If
  End With
End Sub
Nhấp chuột vào đây để mở rộng...

TUYỆT VỜI ÔNG MẶT TRỜI !!!!.
Cảm ơn anh đã giúp.
 
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

micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
2
Đọc
594
tranduc36
T
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
13
Đọc
103
Hoàng Tuấn 868
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
175
Gà Công Nghệ
Gà Công Nghệ
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
20
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
P
Excell code vba : Tìm Cell để sửa dữ liệu
    • Buồn
2
Trả lời
26
Đọc
523
Phạm Trường 80
P
L
Lỗi font khi convert từ pdf
Trả lời
1
Đọc
56
Hoàng Tuấn 868
H
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
77
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
2
Đọc
75
DeTong
D
H
Đổi số thành chữ trong office 365
Trả lời
19
Đọc
1K
HoangTan891026
H
Gà Công Nghệ
Lấy dữ liệu file excel từ sheet này sang sheet khác
Trả lời
4
Đọc
129
Gà Công Nghệ
Gà Công Nghệ
N
Mong mọi người giúp đỡ (1 người xem)
Trả lời
1
Đọc
59
minhminh27
minhminh27
minhduc1o2
Excel lỗi font Time New Roman+
Trả lời
7
Đọc
116
minhduc1o2
minhduc1o2
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
0
Đọc
75
fujishima
F
H
Lọc dữ liệu trong XL
    • Cười
Trả lời
0
Đọc
46
huong.dinh
H
giaiphap
Add-Ins hổ trợ Word trộn danh sách và lưu ra nhiều tệp tin khác nhau.
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
39
Đọc
9K
fujishima
F
K
xin file excel bảng đấu bóng đá
    • Yêu thích
2 3
Trả lời
40
Đọc
25K
subin1905
S
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
24
Đọc
7K
chihuumvc
C
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô.
Trả lời
1
Đọc
66
bebo021999
B
G
Hướng dẫn Lập danh sách File (1 người xem)
    • Không thích
Trả lời
16
Đọc
269
thanhhuy_hvnh
thanhhuy_hvnh
baolong240793
Nhờ Anh/Chị hỗ trợ em hàm Randbetween() với ạ.
Trả lời
4
Đọc
362
bebo021999
B
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
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom