Cách lọc dữ liệu có điều kiện trong Macro (11 người xem)

[doveandrose]

Dovean, cậu kiểm tra lại điều kiện lấy giúp mình, 2 sheet này điều kiện là khác nhau nên mình nghĩ code chỉ đúng với sheet "6" mà không đúng với sheet "7"

[TABLE="width: 422"]
[TR]
[TD]Điều kiện lọc DL của sheet "7"
Convert từ sheet Atual[/TD]
[/TR]
[TR]
[TD]Điều kiện lấy dữ liệu :[/TD]
[/TR]
[TR]
[TD] Cột F8 : lấy dữ liệu với Actual[/TD]
[/TR]
[TR]
[TD] Cột E8 lấy dữ liệu với Assy (Riêng assy không thôi chứ không có assy1,2,3..)[/TD]
[/TR]
[TR]
[TD]Vùng dữ liệu là : H8 : AM:8[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Mong muốn : Khi người dùng chọn ngày tháng thì sẽ list các dữ[/TD]
[/TR]
[TR]
[TD]liệu từ ngày được chọn trở về đầu tháng có trong[/TD]
[/TR]
[TR]
[TD]vùng dữ liệu tương ứng với item trong Cột C[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Ví dụ : mình chọn ngày tháng là 20150712 thì sẽ list[/TD]
[/TR]
[TR]
[TD] tất cả các dữ liệu từ ngày 12/7 trở về 30/06[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[/TABLE]

bạn nghĩ vậy hay bạn đã thấy code cho ra kết quả sai ????

 

[chutuoc909]

theo kết quả chạy được thì mình thấy chưa đúng,
cậu xem ảnh mình đính kèm nhé.


với sheet "7" thì Cột F8 : lấy dữ liệu với Actual

 

[doveandrose]

theo kết quả chạy được thì mình thấy chưa đúng,
cậu xem ảnh mình đính kèm nhé.

View attachment 146169
với sheet "7" thì Cột F8 : lấy dữ liệu với Actual

đúng là đã nhầm . sửa lại như vầy

Public Sub hello67(targetWS As Worksheet, Optional ByVal endDate As Variant, _
Optional ByVal startRow As Integer = 5, Optional ByVal startCol As String = "C", _
Optional ByVal colF As String = "Stock", Optional ByVal ar As Boolean = True)
Dim lr As Long, arr As Variant, r As Long, c As Long, k As Long, arrRS As Variant, today As Variant
lr = Sheet8.UsedRange.SpecialCells(xlCellTypeLastCell).Row
arr = Sheet8.Range("C8:AM" & lr).Value
today = Format(Date, "yyyyMMdd")
If IsMissing(endDate) Then endDate = Sheet8.[AM8].Value
If IsEmpty(endDate) Then endDate = -1
ReDim arrRS(1 To 500000, 1 To 6)
For r = 2 To UBound(arr) Step 1
    If arr(r, 4) = colF Then
        If InStr(arr(r, 3), "Assy") > 0 Then
            If ar Or arr(r, 3) = "Assy" Then
                If IsNumeric(arr(r, 2)) Then
                    If arr(r, 2) > 0 Then
                        For c = 6 To UBound(arr, 2) Step 1
                            If arr(1, c) <= endDate Then
                                If IsNumeric(arr(r, c)) Then
                                    If arr(r, c) > 0 Then
                                        k = k + 1
                                        arrRS(k, 1) = arr(r, 1)
                                        arrRS(k, 2) = 1111000570
                                        arrRS(k, 3) = arr(1, c)
                                        arrRS(k, 4) = arr(1, c)
                                        arrRS(k, 5) = arr(r, c)
                                        arrRS(k, 6) = today
                                    End If
                                End If
                            End If
                        Next
                    End If
                End If
            End If
        End If
    End If
Next
With targetWS
    lr = WorksheetFunction.Max(.Range(startCol & startRow - 1).CurrentRegion.SpecialCells(xlCellTypeLastCell).Row, startRow)
    .Range(startCol & startRow & ":" & startCol & lr).Resize(, 6).ClearContents
    If k > 0 Then .Range(startCol & startRow).Resize(k, 6) = arrRS
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2" Then
    hello67 Sheet6, Target.Value, 7, "B", "Actual", False
End If
End Sub

sub hello6() cứ để như cũ

 

[chutuoc909]

trước tiên là cám ơn Dovean nhiều nhé, vì đã nhiệt tình giúp minh.
mình sẽ test dữ liệu đã, có gì lại mong bạn giúp

 

[ndu96081631]

trước tiên là cám ơn Dovean

Nick người ta là chim hồng mà sửa thành chim.. què là sao thế nhỉ?

 

[chutuoc909]

Nick người ta là chim hồng mà sửa thành chim.. què là sao thế nhỉ?

hehe em không cố ý

 

[chutuoc909]

doveandrose
2 sheet trước đã test và ok vàmình còn 1 sheet nữa, cậu xem và giúp mình nhé, chi tiết mình đã ghi lại trong file

http://www.mediafire.com/download/9zx8i0cixkwd0er/Material_New2.xlsm

cậu download về giúp mình.

 

[doveandrose]

Public Sub hello8()
Dim arr As Variant, r As Long, c As Integer, k As Long, lr As Long, today As Variant
Dim rsArr As Variant, codeNames As Variant
today = Format(Date, "yyyyMMdd")
arr = Sheet4.Range("BM7:CV368").Value
codeNames = Sheet4.Range("Z7:Z368").Value
ReDim rsArr(1 To 500000, 1 To 8)
For r = 2 To UBound(arr) Step 1
    If arr(r, 36) > 0 Then
        For c = 1 To UBound(arr, 2) - 1 Step 1
            If arr(r, c) > 0 Then
                k = k + 1
                rsArr(k, 1) = arr(1, c)
                rsArr(k, 2) = 1111000570
                rsArr(k, 3) = codeNames(r, 1)
                rsArr(k, 4) = arr(r, c)
                rsArr(k, 5) = today
                rsArr(k, 6) = 99991231
                rsArr(k, 7) = today
                rsArr(k, 8) = c
            End If
        Next
    End If
Next
With Sheet9
    lr = WorksheetFunction.Max(.Range("C4").CurrentRegion.SpecialCells(xlCellTypeLastCell).Row, 5)
    .Range("C5:C" & lr).Resize(, 8).ClearContents
    If k > 0 Then .Range("C5").Resize(k, 8).Value = rsArr
    .Range("C5").Resize(k, 8).Sort .[J5], xlAscending
    .Range("J5").Resize(k).ClearContents
End With
End Sub

 

[chutuoc909]

Thật sự cám ơn Doveandrose nhé, những giúp đỡ của bạn đã giúp mình rất nhiều. Nếu ở Hà Nội, Mình muốn mời bạn đi uống cafe

 

[doveandrose]

Thật sự cám ơn Doveandrose nhé, những giúp đỡ của bạn đã giúp mình rất nhiều. Nếu ở Hà Nội, Mình muốn mời bạn đi uống cafe

nhà tôi cũng gần Hà Nội . đi xe đò có mấy nghìn cây số là tới Hà Nội thôi mà ....

 

[chutuoc909]

Doveandrose xem hộ mình sheet "8" với

cậu vô đây down về giúp mình

http://www.mediafire.com/download/ys7vadcyohu4m65/Material+for+WACOM+8+(Rv00)_27082015.xlsm

Cám ơn bạn nhiều.

 

[chutuoc909]

Mình đã fix được rồi nhé,

 

[chutuoc909]

DoveanDrose có online không, xem giúp mình 1 file này với.

mình có 1 vấn đề cần giúp đỡ, bạn xem qua file đính kèm hộ mình nhé.
Mong các thầy và các bạn nào có thể làm được thì giúp mình với ạ.

Xin cảm ơn nhiều.