Mã VBA để chọn cell trong chuỗi (1 người xem)

[Vo Duy Minh]

Chào các bạn
Rất mong nhận được sự giúp đỡ của các bạn để tôi giải quyết vấn đề sau
Tôi cần viết một macro để có thể clear contents của một số cells (trong đó giá trị có thể là số hoặc chữ hoặc trống) trong một cột mà những cells đó bị cách quãng bởi những cells khác sẽ không cần xóa nội dung.
Như trong file đính kèm, cột B có các cell cần xóa (được tô hồng), những cells này (có số lượng nhất định, chẳng hạn 8) ở dưới cell có giá trị là "Noted". Vì thế tôi muốn được các bạn giúp viết một code đại khái là Range là 8 cells ở dưới cell có giá trị "Noted" sẽ được xóa khi bấm tổ hợp Control + Shift + Q.
Hiện nay tôi có viết (xem Macro), nhưng rất thủ công nên mất rất nhiều thời gian khi cột có đến 3000 rows.
Xin cám ơn các bạn trước.

 

[CHAOQUAY]

Chào các bạn
Rất mong nhận được sự giúp đỡ của các bạn để tôi giải quyết vấn đề sau
Tôi cần viết một macro để có thể clear contents của một số cells (trong đó giá trị có thể là số hoặc chữ hoặc trống) trong một cột mà những cells đó bị cách quãng bởi những cells khác sẽ không cần xóa nội dung.
Như trong file đính kèm, cột B có các cell cần xóa (được tô hồng), những cells này (có số lượng nhất định, chẳng hạn 8) ở dưới cell có giá trị là "Noted". Vì thế tôi muốn được các bạn giúp viết một code đại khái là Range là 8 cells ở dưới cell có giá trị "Noted" sẽ được xóa khi bấm tổ hợp Control + Shift + Q.
Hiện nay tôi có viết (xem Macro), nhưng rất thủ công nên mất rất nhiều thời gian khi cột có đến 3000 rows.
Xin cám ơn các bạn trước.

Bài này có thể dùng autofilter để lọc rồi xóa sẽ nhanh hơn.

Bác làm rõ thêm: Ô màu xanh phía trên "Noted" có giá trị max là khoảng bao nhiêu?

 

[vu_tuan_manh_linh]

Code của bạn đây:

Sub Clear_Records()
Dim i, j, arr(1 To 65536)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 1 To Range("B65536").End(xlUp).Row
    If Cells(i, 2).Value = "Noted" Then
        j = j + 1
        arr(j) = i
    End If
Next
j = j + 1
arr(j) = Range("B65536").End(xlUp).Row + 2
For i = 1 To j - 1
    Range("B" & arr(i) + 1 & ":B" & arr(i + 1) - 2).ClearContents
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[thnghiachau]

Chào các bạn
Rất mong nhận được sự giúp đỡ của các bạn để tôi giải quyết vấn đề sau
Tôi cần viết một macro để có thể clear contents của một số cells (trong đó giá trị có thể là số hoặc chữ hoặc trống) trong một cột mà những cells đó bị cách quãng bởi những cells khác sẽ không cần xóa nội dung.
Như trong file đính kèm, cột B có các cell cần xóa (được tô hồng), những cells này (có số lượng nhất định, chẳng hạn 8) ở dưới cell có giá trị là "Noted". Vì thế tôi muốn được các bạn giúp viết một code đại khái là Range là 8 cells ở dưới cell có giá trị "Noted" sẽ được xóa khi bấm tổ hợp Control + Shift + Q.
Hiện nay tôi có viết (xem Macro), nhưng rất thủ công nên mất rất nhiều thời gian khi cột có đến 3000 rows.
Xin cám ơn các bạn trước.

Cho hỏi Cell màu xanh có chữ Noted là luôn có value là string "Noted" phải không?
trước cell có chữ Noted (cũng màu xanh) thì giữ lại không "đụng chạm" tới phải không?
Như bạn nói là "Clear Contents" các cell dưới Cell xanh Noted phải không?

Thôi tạm thời cứ cho là thế đi nhá bạn...
Bạn coi file đính kèm coi có đúng ý không hen!
Mình sử dung phương thức FIND => như thế số lần vòng lặp bằng đúng số lần xuất hiện cell màu xanh "Noted" mà thôi....

 

[Vo Duy Minh]

Cho hỏi Cell màu xanh có chữ Noted là luôn có value là string "Noted" phải không?
trước cell có chữ Noted (cũng màu xanh) thì giữ lại không "đụng chạm" tới phải không?
Như bạn nói là "Clear Contents" các cell dưới Cell xanh Noted phải không?

Thôi tạm thời cứ cho là thế đi nhá bạn...
Bạn coi file đính kèm coi có đúng ý không hen!
Mình sử dung phương thức FIND => như thế số lần vòng lặp bằng đúng số lần xuất hiện cell màu xanh "Noted" mà thôi....

Cám ơn bạn, tôi thấy rất hoàn hảo.
Hơn nữa, việc trả lời của bạn (và các bạn khác) cũng rất nhanh chóng.
Tôi không thể mong gì hơn.
Một lần nữa, xin cám ơn bạn rất nhiều.

Bài đã được tự động gộp: 13/7/20

Code của bạn đây:

Sub Clear_Records()
Dim i, j, arr(1 To 65536)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 1 To Range("B65536").End(xlUp).Row
    If Cells(i, 2).Value = "Noted" Then
        j = j + 1
        arr(j) = i
    End If
Next
j = j + 1
arr(j) = Range("B65536").End(xlUp).Row + 2
For i = 1 To j - 1
    Range("B" & arr(i) + 1 & ":B" & arr(i + 1) - 2).ClearContents
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Cám ơn bạn rất nhiều, tôi thấy rất hoàn hảo.
Tôi cũng không ngờ nhận được các phản hồi nhanh như thế và không chỉ một mà còn khác bạn khác nữa.
Một lần nữa xin cám ơn cả trình độ và nhiệt tình của bạn. Tôi sẽ ứng dụng và nếu có vấn đề gì xin được bạn giúp đỡ tiếp.

 

[Ba Tê]

Như trong file đính kèm, cột B có các cell cần xóa (được tô hồng), những cells này (có số lượng nhất định, chẳng hạn 8) ở dưới cell có giá trị là "Noted". Vì thế tôi muốn được các bạn giúp viết một code đại khái là Range là 8 cells ở dưới cell có giá trị "Noted" sẽ được xóa

Bạn chạy thử Sub này, gán vào tổ hợp phím tắt nào đó tùy bạn.

Public Sub Del_8R()
Const Rws As Long = 8   'So dong duoi Txt can xoa'
Dim I As Long, R As Long, Txt As String
    Txt = "Noted"       'Chuoi can tim'
    R = Range("B10000").End(xlUp).Row   'Dong cuoi cung trong cot B'
For I = 1 To R
    If Cells(I, 2).Value = Txt Then     'Dong I tim thay Txt'
        Cells(I + 1, 2).Resize(Rws).ClearContents                    'Xoa tu Dong I+1 xuong Rws dong'
        I = I + Rws + 1       'Bo qua Rws+1 dong khong tim Txt'
    End If
Next I
End Sub

 

[Vo Duy Minh]

Bạn chạy thử Sub này, gán vào tổ hợp phím tắt nào đó tùy bạn.

Public Sub Del_8R()
Const Rws As Long = 8   'So dong duoi Txt can xoa'
Dim I As Long, R As Long, Txt As String
    Txt = "Noted"       'Chuoi can tim'
    R = Range("B10000").End(xlUp).Row   'Dong cuoi cung trong cot B'
For I = 1 To R
    If Cells(I, 2).Value = Txt Then     'Dong I tim thay Txt'
        Cells(I + 1, 2).Resize(Rws).ClearContents                    'Xoa tu Dong I+1 xuong Rws dong'
        I = I + Rws + 1       'Bo qua Rws+1 dong khong tim Txt'
    End If
Next I
End Sub

Cám ơn bạn rất nhiều.
Tôi đã chạy thử thì thấy rất hiệu quả.
Tôi chân thành cám ơn bạn (và những bạn khác) với trình độ và nhiệt tình của các bạn trong Diễn đàn.