Nhờ mọi người giúp về code lọc theo điều kiện chữ cái đầu tiên (2 người xem)

[THEO EGN]

Xin chào mọi người, Nhờ các anh chị chỉ giúp,
giờ em muốn lọc dữ liệu cột D và theo chữ cái đầu tiên là B trả KQ vào cột I, và đi kèm với nó trả KQ vào cột H lấy từ cột A!
Mình xin cám ơn !!

 

[Thóc Sama]

View attachment 279478
Xin chào mọi người, Nhờ các cao nhân chỉ giúp
Mình muốn lọc dữ liệu cột D và theo chữ cái đầu tiên là B trả KQ vào cột I, và đi kèm với nó trả KQ vào cột H lấy từ cột A!
Mình xin cám ơn !!

Góp ý cho bạn mình:
1. Không dùng đại từ nhân xưng theo kiểu "cao nhân, tiểu nhân..."
2. Thay vì "mình muốn thì-> nhờ anh/chị..."
3. Đưa file đính kèm lên đây.

 

[THEO EGN]

Góp ý cho bạn mình:
1. Không dùng đại từ nhân xưng theo kiểu "cao nhân, tiểu nhân..."
2. Thay vì "mình muốn thì-> nhờ anh/chị..."
3. Đưa file đính kèm lên đây.

Xin cám ơn a, vì đã góp ý, e gửi file nhờ a giúp

 

[Phuocam]

giờ em muốn lọc dữ liệu cột D và theo chữ cái đầu tiên là B trả KQ vào cột I, và đi kèm với nó trả KQ vào cột H lấy từ cột A!
Mình xin cám ơn !!

Dùng trích lọc nâng cao, điều kiện là:

Cách 1: B*

Cách 2: =LEFT(D4,1)="B"

.

 

[Thóc Sama]

Xin cám ơn a, vì đã góp ý, e gửi file nhờ a giúp

Bạn mình thử code dưới xem được chưa!
Chú ý thêm là không nên viết tắt nhé!

Sub ABC()
    Dim Arr(), Res(), i As Long, k As Long
    On Error Resume Next
    With Sheet8
        .Range("H2:I10000").ClearContents
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:D" & lr).Value
        ReDim Res(1 To UBound(Arr), 1 To 2)
        For i = 1 To UBound(Arr)
            If Left(Arr(i, 4), 1) = UCase(.Cells(1, 9)) Then
                k = k + 1
                Res(k, 1) = Arr(i, 1)
                Res(k, 2) = Arr(i, 4)
            End If
        Next i
        .Range("H2").Resize(k, 2).Value = Res
    End With
End Sub

 

[THEO EGN]

Bạn mình thử code dưới xem được chưa!
Chú ý thêm là không nên viết tắt nhé!

Sub ABC()
    Dim Arr(), Res(), i As Long, k As Long
    On Error Resume Next
    With Sheet8
        .Range("H2:I10000").ClearContents
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:D" & lr).Value
        ReDim Res(1 To UBound(Arr), 1 To 2)
        For i = 1 To UBound(Arr)
            If Left(Arr(i, 4), 1) = UCase(.Cells(1, 9)) Then
                k = k + 1
                Res(k, 1) = Arr(i, 1)
                Res(k, 2) = Arr(i, 4)
            End If
        Next i
        .Range("H2").Resize(k, 2).Value = Res
    End With
End Sub

Cám ơn anh, Em làm được rồi ạ !!!

 

[BuiQuangThuan]

On Error Resume Next

Thêm cái này vào để làm gì thế nhỉ bạn.

 

[Phuocam]

Thêm cái này vào để làm gì thế nhỉ bạn.

Có thể là để bẫy lỗi, như:

1. lr nhỏ hơn 2

2. K = 0

...