Trích lọc theo 1 số điều kiện cụ thể (1 người xem)

[quoc_huy1702]

Chào mọi người;
E có 1 đoạn code đang áp dụng nhưng chưa thỏa mãn hết các yêu cầu đặt ra trong việc trích lọc dữ liệu

E chưa biết khi trích lọc nhiều điều kiện như sau thì phải thêm code thế nào?

Phần chọn: điệu kiện đáp ứng đồng thời cả 2 điều bên dưới

1/ Chọn dữ liệu xuất "X" ( cột đánh số thự tự là 2)
2/ Chọn tiếp cột dữ liệu TKCo có các mã là 511011 , 511015 ,512021 ,512022 , ( cột đánh số thứ tự 10)

Bỏ chọn các cột
1/Bỏ chọn cột dữ liệu MAVT có "TVAT" và "HDHUY"

e chỉ mới biết làm Phần 1 mục 1/ và 1 phần của mục 2/

Xin mọi người giúp đỡ thêm.

Public Sub XuaT_ban()Dim Rng(), Arr(), I As Long, K As Long, Tem As Long
Dim example As Range
Set example = Range("A5:F15000")
example.ClearContents
With Sheets("Du lieu")
Rng = .Range(.[A3], .[A65000].End(xlUp)).Resize(, 37).Value
End With
ReDim Arr(1 To UBound(Rng, 1), 1 To 8)
For I = 1 To UBound(Rng, 1)
If Rng(I, 2) = "X" And Rng(I, 10) = "511015 " Then
K = K + 1
Arr(K, 1) = Rng(I, 7): Arr(K, 2) = Rng(I, 11)
Arr(K, 3) = Rng(I, 12): Arr(K, 4) = Rng(I, 13)
Arr(K, 5) = Rng(I, 16): Arr(K, 6) = Rng(I, 19)
End If
Next I
If K Then Sheets("Xuat ban").[A5].Resize(K, 8).Value = Arr
End Sub

File đây ạ
http://www.mediafire.com/?w88fx69bnx9nu4z

 

[ThuNghi]

Chào mọi người;
E có 1 đoạn code đang áp dụng nhưng chưa thỏa mãn hết các yêu cầu đặt ra trong việc trích lọc dữ liệu

E chưa biết khi trích lọc nhiều điều kiện như sau thì phải thêm code thế nào?

Phần chọn: điệu kiện đáp ứng đồng thời cả 2 điều bên dưới

1/ Chọn dữ liệu xuất "X" ( cột đánh số thự tự là 2)
2/ Chọn tiếp cột dữ liệu TKCo có các mã là 511011 , 511015 ,512021 ,512022 , ( cột đánh số thứ tự 10)

Bỏ chọn các cột
1/Bỏ chọn cột dữ liệu MAVT có "TVAT" và "HDHUY"

e chỉ mới biết làm Phần 1 mục 1/ và 1 phần của mục 2/

Xin mọi người giúp đỡ thêm.


File đây ạ
http://www.mediafire.com/?w88fx69bnx9nu4z

Đã làm tới vậy mà cũng không chịu thêm vài cái if là xong thôi.
Sao tôi cũng dùng thử Auto Filter mà kết quả kg ra như bạn.

Public Sub XuaT_ban()
Dim Rng(), Arr(), ArrCol(), i As Long, k As Long, iC&
ArrCol = Array(7, 11, 12, 13, 16, 19)
With Sheets("Xuat ban")
    .Range("A5:F15000").ClearContents
End With
With Sheets("Du lieu")
    Rng = .Range(.[A3], .[A65000].End(xlUp)).Resize(, 37).Value
End With
ReDim Arr(1 To UBound(Rng, 1), 1 To 8)
    For i = 1 To UBound(Rng, 1)
        If Rng(i, 2) = "X" Then
            If Left(Rng(i, 10), 2) = "51" Then
                If Left(Rng(i, 11), 4) <> "TVAT" Then
                    If Left(Rng(i, 11), 5) <> "HDHUY" Then
                        k = k + 1
                        For iC = 0 To UBound(ArrCol)
                            Arr(k, iC + 1) = Rng(i, ArrCol(iC))
                        Next iC
                    End If
                End If
            End If
        End If
    Next i
If k Then Sheets("Xuat ban").[A5].Resize(k, 8).Value = Arr
End Sub

 

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

Đã làm tới vậy mà cũng không chịu thêm vài cái if là xong thôi.
Sao tôi cũng dùng thử Auto Filter mà kết quả kg ra như bạn.

Public Sub XuaT_ban()
Dim Rng(), Arr(), ArrCol(), i As Long, k As Long, iC&
ArrCol = Array(7, 11, 12, 13, 16, 19)
With Sheets("Xuat ban")
    .Range("A5:F15000").ClearContents
End With
With Sheets("Du lieu")
    Rng = .Range(.[A3], .[A65000].End(xlUp)).Resize(, 37).Value
End With
ReDim Arr(1 To UBound(Rng, 1), 1 To 8)
    For i = 1 To UBound(Rng, 1)
        If Rng(i, 2) = "X" Then
            If Left(Rng(i, 10), 2) = "51" Then
                If Left(Rng(i, 11), 4) <> "TVAT" Then
                    If Left(Rng(i, 11), 5) <> "HDHUY" Then
                        k = k + 1
                        For iC = 0 To UBound(ArrCol)
                            Arr(k, iC + 1) = Rng(i, ArrCol(iC))
                        Next iC
                    End If
                End If
            End If
        End If
    Next i
If k Then Sheets("Xuat ban").[A5].Resize(k, 8).Value = Arr
End Sub

Đây cũng là dạng bài áp dụng làm = ADO khá thú vị, anh ThuNghi thử xem nhé.

 

[quoc_huy1702]

Đã làm tới vậy mà cũng không chịu thêm vài cái if là xong thôi.
Sao tôi cũng dùng thử Auto Filter mà kết quả kg ra như bạn.

a làm đúng rồi anh; lúc nảy e xóa bớt dòng; e quên paste cái giá trị lọc dữ liệu lại

 

[ThuNghi]

Đây cũng là dạng bài áp dụng làm = ADO khá thú vị, anh ThuNghi thử xem nhé.

ADO, it's not big! So easy!

Sub Xuat_Ban_ADO()
Dim mySQL$, SourceFile$
Dim Cnn As New ADODB.Connection
Dim Rcs As New ADODB.Recordset
Set Cnn = New ADODB.Connection
SourceFile = ThisWorkbook.FullName
With Sheets("Du lieu")
   .Range(.[A3], .[A65000].End(xlUp)).Resize(, 37).Name = "Data"
End With
''Tao Ket noi voi file du lieu nguon: Ex 2007 and 2010'
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
''---------------------------------------------------------------------------'
mySQL = "SELECT  F7, F11,F12,F13,F16,F19 FROM [Data]" & Chr(10)
mySQL = mySQL & "Where F2 = 'X'" & Chr(10)
mySQL = mySQL & "and left(F10,2)= '51'" & Chr(10)
mySQL = mySQL & "and trim(F11) <> 'TVAT'" & Chr(10)
mySQL = mySQL & "and trim(F11) <> 'HDHUY'" & Chr(10)
Rcs.Open mySQL, Cnn, adOpenKeyset, adLockOptimistic
''Gan vao sh'
With Sheets("Xuat ban")
    .[A5].Resize(50000, 8).ClearContents
    .[A5].CopyFromRecordset Rcs
End With
'Refresh lai hai bien cnEx va Rcs:'
Rcs.Close: Set Rcs = Nothing
Cnn.Close: Set Cnn = Nothing
End Sub