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

[xuanphat.csdn]

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 ạ.

 

[Hoàng Trọng Nghĩa]

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:

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

 

[Ba Tê]

     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.

        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

 

[Hoàng Trọng Nghĩa]

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.

        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.

 

[HieuCD]

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

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

 

[VetMini]

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

 

[Hai Lúa Miền Tây]

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é:

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