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

One Response

1. hands says:

   31/01/2023 at 1:27 pm

   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

   thêm lệnh chuyển số

   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

   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

   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
   Chỉnh lại code theo gợi ý của bạn @VetMini

   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

   TUYỆT VỜI ÔNG MẶT TRỜI !!!!.
   Cảm ơn anh đã giúp.

   Reply