Tìm và lọc những cột có chứa điều kiện

[zPeterPan]

Em chào các Thầy/cô và các anh chị em trên diễn đàn. . .
Em có bảng dữ liệu khoảng hơn 11342 cột và em muốn tìm và lọc những cột nào chỉ chứa giá trị 0 và giá trị lớn hơn hoặc bằng với giá trị trong ô "D1" của Sheet1.

Và kết quả những giá trị tìm lọc được sẽ ra ở Sheet2. . .
Em ví dụ 4 cột kết quả ạ. . . ( Em tìm thủ công được 4 cột này ạ) Kết quả có thể thay đổi theo giá trị ở ô "D1" của Sheet1 ạ. . .

Kính nhờ Thầy/cô và các anh chị em trên diễn đàn viết giúp em đoạn code để chạy cho nhanh ạ. . . Em xin cảm ơn ạ. . .

 

[BuiQuangThuan]

Em chào các Thầy/cô và các anh chị em trên diễn đàn. . .
Em có bảng dữ liệu khoảng hơn 11342 cột và em muốn tìm và lọc những cột nào chỉ chứa giá trị 0 và giá trị lớn hơn hoặc bằng với giá trị trong ô "D1" của Sheet1.
View attachment 269724
Và kết quả những giá trị tìm lọc được sẽ ra ở Sheet2. . .
Em ví dụ 4 cột kết quả ạ. . . ( Em tìm thủ công được 4 cột này ạ) Kết quả có thể thay đổi theo giá trị ở ô "D1" của Sheet1 ạ. . .
View attachment 269725
Kính nhờ Thầy/cô và các anh chị em trên diễn đàn viết giúp em đoạn code để chạy cho nhanh ạ. . . Em xin cảm ơn ạ. . .

kết quả bạn làm thấy có 3 cột cuối đúng, cột đầu sai
Thử với cách thêm cột phụ.

 

[bebo021999]

KQ mong muốn chỉ có 3 cột sau. Cột đầu có số 2 ở dòng 19 nên không thỏa nhé

Sub tests()
Dim crR As Range
Dim ws1, ws2 As Worksheet
Dim Lr, Lc, i, j, r, c, cl As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set crR = ws1.Range("A4").CurrentRegion
Lr = crR.Rows.Count
Lc = crR.Columns.Count
With WorksheetFunction
For i = 1 To Lc
r = 3
c = .CountIf(ws1.Range(ws1.Cells(2, i), ws1.Cells(Lr, i)), "<" & ws1.Range("D1")) - .CountIf(ws1.Range(ws1.Cells(2, i), ws1.Cells(Lr, i)), 0)
    If c = 0 Then
    cl = cl + 1
        For j = 4 To Lr
        r = r + 1
        ws2.Cells(r, cl).Value = ws1.Cells(j, i).Value
        Next
    End If
Next
End With
End Sub

 

[snow25]

KQ mong muốn chỉ có 3 cột sau. Cột đầu có số 2 ở dòng 19 nên không thỏa nhé

Sub tests()
Dim crR As Range
Dim ws1, ws2 As Worksheet
Dim Lr, Lc, i, j, r, c, cl As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set crR = ws1.Range("A4").CurrentRegion
Lr = crR.Rows.Count
Lc = crR.Columns.Count
With WorksheetFunction
For i = 1 To Lc
r = 3
c = .CountIf(ws1.Range(ws1.Cells(2, i), ws1.Cells(Lr, i)), "<" & ws1.Range("D1")) - .CountIf(ws1.Range(ws1.Cells(2, i), ws1.Cells(Lr, i)), 0)
    If c = 0 Then
    cl = cl + 1
        For j = 4 To Lr
        r = r + 1
        ws2.Cells(r, cl).Value = ws1.Cells(j, i).Value
        Next
    End If
Next
End With
End Sub

Khai báo biến này trong vb thì được còn vba nó không nhận đâu anh ạ.