Hỗ trợ code lọc dữ liệu copy qua sheet khác

Blue Softs Liên hệ QC

xuanphat.csdn

Thành viên mới
Tham gia
1/9/19
Bài viết
11
Được thích
1
Kính chào anh/chị trên diễn đàn!
Trên File mình đính kèm, Khi mình bấm nút Thêm tại sheet database để chọn điều kiện lọc dữ liệu từ sheet source qua thì khi không thỏa được điều kiện lọc thì excel quay vòng vòng, phải tắt file mở lên lại mới tiếp tục được. Em mới tập tành VBA nên nhờ các anh trên diễn đàn chỉ giáo giúp. Code em viết thấy hơi rườm rà nên anh chị có thể sửa lại cho gọn gàng giúp với ạ.
 

File đính kèm

  • Import.xlsm
    151.2 KB · Đọc: 25

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,418
Được thích
16,189
Giới tính
Nam
Kính chào anh/chị trên diễn đàn!
Trên File mình đính kèm, Khi mình bấm nút Thêm tại sheet database để chọn điều kiện lọc dữ liệu từ sheet source qua thì khi không thỏa được điều kiện lọc thì excel quay vòng vòng, phải tắt file mở lên lại mới tiếp tục được. Em mới tập tành VBA nên nhờ các anh trên diễn đàn chỉ giáo giúp. Code em viết thấy hơi rườm rà nên anh chị có thể sửa lại cho gọn gàng giúp với ạ.
Code của nút NHẬP nha bạn:

Mã:
Private Sub cmd_nhap_Click()
    Dim ctr As Control
    For Each ctr In Me.Controls
        If TypeName(ctr) = "ComboBox" Then
            If Not ctr.MatchFound Then
                MsgBox "Ban chua khai bao day du du lieu. Vui long kiem tra lai"
                ctr.SetFocus
                ctr.DropDown
                Exit Sub
            End If
        End If
    Next
    
    Dim c As Byte
    Dim arrData, arrResult
    Dim e As Long, n As Long, r As Long, u As Long
    e = Sheets("source").Range("A" & Rows.Count).End(xlUp).Row
    arrData = Sheets("source").Range("A4:N" & e).Value
    u = UBound(arrData)
    ReDim arrResult(1 To u, 1 To 14)
    For r = 1 To u
        If arrData(r, 1) = cb_Year_20.Text _
            And arrData(r, 2) = cb_MuaCao_21.Text _
            And arrData(r, 5) = cb_To_22.Text _
            And arrData(r, 12) = cb_NDC_23.Text _
            And arrData(r, 13) = cb_PC_24.Text Then
            n = n + 1
            For c = 1 To 14
                arrResult(n, c) = arrData(r, c)
            Next
        End If
    Next
    
    If n Then
        With Sheets("database")
            e = .Range("C" & Rows.Count).End(xlUp).Row + 1
            .Range("C" & e).Resize(n, 14).Value = arrResult
            .Range("A3").CurrentRegion.EntireColumn.AutoFit
        End With
        MsgBox "Them du lieu thanh cong"
        Unload Me
    Else
        MsgBox "Khong tim thay du lieu. Vui long kiem tra lai"
    End If
End Sub
 
Upvote 0

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia
5/5/09
Bài viết
12,114
Được thích
17,491
PHP:
     If arrData(r, 1) = cb_Year_20.Text _
            And arrData(r, 2) = cb_MuaCao_21.Text _
            And arrData(r, 5) = cb_To_22.Text _
            And arrData(r, 12) = cb_NDC_23.Text _
            And arrData(r, 13) = cb_PC_24.Text Then
            n = n + 1
            For c = 1 To 14
                arrResult(n, c) = arrData(r, c)
            Next
        End If
1 cái IF với 4 cái AND, dòng nào cũng phải xét 5 điều kiện.
Nếu là tôi thì viết thành 5 cái IF, chỉ cần đến cái IF không thỏa điều kiện thì bỏ qua, không xét nữa.
PHP:
        If arrData(r, 1) = cb_Year_20.Text Then
            If arrData(r, 2) = cb_MuaCao_21.Text Then
                If arrData(r, 5) = cb_To_22.Text Then
                    If arrData(r, 12) = cb_NDC_23.Text Then
                        If arrData(r, 13) = cb_PC_24.Text Then
                            n = n + 1
                            For c = 1 To 14
                                arrResult(n, c) = arrData(r, c)
                            Next
                        End If
                    End If
                End If
            End If
        End If
 
Upvote 0

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,418
Được thích
16,189
Giới tính
Nam
1 cái IF với 4 cái AND, dòng nào cũng phải xét 5 điều kiện.
Nếu là tôi thì viết thành 5 cái IF, chỉ cần đến cái IF không thỏa điều kiện thì bỏ qua, không xét nữa.
PHP:
        If arrData(r, 1) = cb_Year_20.Text Then
            If arrData(r, 2) = cb_MuaCao_21.Text Then
                If arrData(r, 5) = cb_To_22.Text Then
                    If arrData(r, 12) = cb_NDC_23.Text Then
                        If arrData(r, 13) = cb_PC_24.Text Then
                            n = n + 1
                            For c = 1 To 14
                                arrResult(n, c) = arrData(r, c)
                            Next
                        End If
                    End If
                End If
            End If
        End If
Dường như anh sai rồi. AND chỉ cần 1 mục FALSE thì False cả biểu thức, vì thế nó không xét hết cả 5 lượt đâu.
 
Upvote 0

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,491
Được thích
17,821
Dường như anh sai rồi. AND chỉ cần 1 mục FALSE thì False cả biểu thức, vì thế nó không xét hết cả 5 lượt đâu.
Mượn file của thớt chạy Sub Test so sánh thời gian, 5 IF chạy nhanh hơn
Mã:
Sub Test()
  Const L& = 10000
 
  Call Time_AND(L)
  Call Time_IF(L)
End Sub

Sub Time_AND(ByVal L&)
  Dim sArr(), res(), i&, sRow&, n&, k&, t#
    
  t = Timer
  i = Sheets("source").Range("A" & Rows.Count).End(xlUp).Row
  sArr = Sheets("source").Range("E4:N" & i).Value
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 1)
 
  For n = 1 To L
    For i = 1 To sRow
      If sArr(i, 1) = 1 And sArr(i, 2) = 1 And sArr(i, 3) = 1 _
              And sArr(i, 7) = 1 And sArr(i, 8) = "d3" Then
        k = k + 1
        res(k, 1) = True
      End If
    Next i
  Next n
  MsgBox ("Thoi gian dung 4 AND:    " & Timer - t)
End Sub

Sub Time_IF(ByVal L&)
  Dim sArr(), res(), i&, sRow&, n&, k&, t#
    
  t = Timer
  i = Sheets("source").Range("A" & Rows.Count).End(xlUp).Row
  sArr = Sheets("source").Range("E4:N" & i).Value
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 1)
 
  For n = 1 To L
    For i = 1 To sRow
      If sArr(i, 1) = 1 Then
        If sArr(i, 2) = 1 Then
          If sArr(i, 3) = 1 Then
            If sArr(i, 7) = 1 Then
              If sArr(i, 8) = "d3" Then
                k = k + 1
                res(k, 1) = True
              End If
            End If
          End If
        End If
      End If
    Next i
  Next n
  MsgBox ("Thoi gian dung 5 IF:    " & Timer - t)
End Sub
 
Upvote 0

VetMini

Chuyên gia GPE
Tham gia
21/12/12
Bài viết
12,350
Được thích
15,911
Dường như anh sai rồi. AND chỉ cần 1 mục FALSE thì False cả biểu thức, vì thế nó không xét hết cả 5 lượt đâu.
Không đúng.
Nên nhớ IF của VBA là phép xét 0 hay khác 0, và AND/OR của VBA là phép tính bit chứ không phải True/False. Nó phải tính mọi biểu thức rồi nmới biết có bằng 0 hay không.

IF và AND/OR của bảng tính mới thực sự tính True/False. Và vì vậy chúng có thể đi tắt.

Đính chính: phép tính bit vẫn cho cả biểu thức AND bằng zê rô nếu một trong những biểu thức con là False, và cả biểu thức OR khác 0 nếu một trong những biểu thức con là True. Tuy nhiên, vì sự ohuwcs tạp của phép tính cho nên VBA vẫn không cho đi tắt.

Chạy thử code Sub t dưới đây sẽ thấy nó đi qua đầy đủ f1, f2, f3

Sub t()
If f1() And f2() And f3() Then MsgBox "t"
End Sub

Function f1()
MsgBox "f1"
f1 = False
End Function
Function f2()
MsgBox "f2"
f2 = False
End Function
Function f3()
MsgBox "f3"
f3 = False
End Function
 
Lần chỉnh sửa cuối:
Upvote 0

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,142
Được thích
15,447
Giới tính
Nam
Nghề nghiệp
Làm ruộng.
Kính chào anh/chị trên diễn đàn!
Trên File mình đính kèm, Khi mình bấm nút Thêm tại sheet database để chọn điều kiện lọc dữ liệu từ sheet source qua thì khi không thỏa được điều kiện lọc thì excel quay vòng vòng, phải tắt file mở lên lại mới tiếp tục được. Em mới tập tành VBA nên nhờ các anh trên diễn đàn chỉ giáo giúp. Code em viết thấy hơi rườm rà nên anh chị có thể sửa lại cho gọn gàng giúp với ạ.
Bạn thử với code sau nhé:

Mã:
Private Sub cmd_nhap_Click()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        .Execute ("Insert Into [database$A3:AR] Select * from [source$A3:N] Where [" & Sheet1.Range("A3") & "] = " & cb_Year_20.Text & " And MuaCao = " & cb_MuaCao_21.Text & " And [" & Sheet1.Range("E3") & "] = " & cb_To_22.Text & " And NhipDoCao Like '" & cb_NDC_23.Text & "'" & " And PhienCao Like '" & cb_PC_24.Text & "'")
    End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Top Bottom