HỎI: Code xóa dòng có điều kiện

[anhtb82]

Xin chào tất cả mọi người, mình có 1 code xóa dòng như thể này, nhưng chỉ xóa được với số lượng dữ liệu nhỏ (khoảng <100 dòng mới sử dụng được). Mình cũng có thể xóa từng dòng như mình đã thử rồi, lượng dữ liệu mình rất lớn nên xóa rất lâu. Mình muốn xóa 1 lúc hết tất cả theo điều kiện như dưới. Mọi người xem và sửa giúp mình nhé.
Mình cảm ơn!

Mô tả code: Nếu giá trị ô N2 KHÁC V4B hoặc V4D thì sẽ xóa hàng 2 đi.

Sub Xoadong()
Dim i As Long, rng As String
i = Range("A2").CurrentRegion.Rows.Count
For j = 2 To i
If Range("N" & j) <> "V4B" And Range("N" & j) <> "V4D" Then
rng = rng & "A" & j & ","
End If
Next j
If Len(rng) > 0 Then
Range(Left(rng, Len(rng) - 1)).EntireRow.Delete
Else
Exit Sub
End If
End Sub

 

[Ba Tê]

Mình làm thành công rồi, code bạn hay quá, bây h mình muốn sử dụng code của bạn để lọc điều kiện cho cột I. Nếu cột I là Dynapac hoặc Ojitex sẽ xóa đi.
Mình thay code thành ntn: 14 -> 9

Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 9).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 9)
For I = 1 To R
    If sArr(I, 9) <> "OJITEX HAIPHONG CO., LTD." And sArr(I, 9) <> "DYNAPAC (HAIPHONG) CO.,LTD" Then
        K = K + 1
        For J = 1 To 9
            dArr(K, J) = sArr(I, J)
        Next J
    End If
Next I
Range("A2").Resize(R, 9).ClearContents
Range("A2").Resize(K, 9) = dArr

Nhưng nó lại không xóa được hết, để thừa lại các giá trị tại cột thứ 10 -> 14.
Bạn xem giúp mình với

Nếu kết quả bạn muốn có đủ 14 cột thì phải vầy:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 14).Value          '<----Thay bằng 9'
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 14)               '<----Thay bằng 9'
For I = 1 To R
    If sArr(I, 9) <> "OJITEX HAIPHONG CO., LTD." And sArr(I, 9) <> "DYNAPAC (HAIPHONG) CO.,LTD" Then
        K = K + 1
        For J = 1 To 14                         '<----Thay bằng 9'
            dArr(K, J) = sArr(I, J)
        Next J
    End If
Next I
Range("A2").Resize(R, 14).ClearContents
Range("A2").Resize(K, 14) = dArr         '<----Thay bằng 9'
End Sub

Nếu kết quả bạn chỉ cần 9 cột thì thay các số 14 thành 9 ở các dòng có ghi chú trong code trên.

 

[anhtb82]

Nếu kết quả bạn muốn có đủ 14 cột thì phải vầy:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 14).Value          '<----Thay bằng 9'
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 14)               '<----Thay bằng 9'
For I = 1 To R
    If sArr(I, 9) <> "OJITEX HAIPHONG CO., LTD." And sArr(I, 9) <> "DYNAPAC (HAIPHONG) CO.,LTD" Then
        K = K + 1
        For J = 1 To 14                         '<----Thay bằng 9'
            dArr(K, J) = sArr(I, J)
        Next J
    End If
Next I
Range("A2").Resize(R, 14).ClearContents
Range("A2").Resize(K, 14) = dArr         '<----Thay bằng 9'
End Sub

Nếu kết quả bạn chỉ cần 9 cột thì thay các số 14 thành 9 ở các dòng có ghi chú trong code trên.

Đúng là Gạo Cội có khác, mình làm được rồi. Cảm ơn bạn!

 

[anhtb82]

Nếu kết quả bạn muốn có đủ 14 cột thì phải vầy:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 14).Value          '<----Thay bằng 9'
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 14)               '<----Thay bằng 9'
For I = 1 To R
    If sArr(I, 9) <> "OJITEX HAIPHONG CO., LTD." And sArr(I, 9) <> "DYNAPAC (HAIPHONG) CO.,LTD" Then
        K = K + 1
        For J = 1 To 14                         '<----Thay bằng 9'
            dArr(K, J) = sArr(I, J)
        Next J
    End If
Next I
Range("A2").Resize(R, 14).ClearContents
Range("A2").Resize(K, 14) = dArr         '<----Thay bằng 9'
End Sub

Nếu kết quả bạn chỉ cần 9 cột thì thay các số 14 thành 9 ở các dòng có ghi chú trong code trên.

Bạn có thể xem giúp mình ví dụ này được không?
http://www.giaiphapexcel.com/forum/...e-cố-định-trong-VBA-Excel&p=771504#post771504
Cảm ơn bạn!

 

[Ldh1984]

hi

 

[Hoàng Tuấn 868]

bác ơi mình có file Book2 như đã gửi lên:
mình muốn viết đoạn code với điều kiện khi B2 nhảy số lớn hơn >21 thì xóa từ B4:B24.
mình có đoạn code như sau, đang muốn giúp thêm đoạn xóa:

code:
Sub InG_N()

Dim form As Worksheet
Dim G_N As Worksheet

Set G_N = ThisWorkbook.Sheets("G_N")

''''''''''copy danh sach''''''''
Dim hang_cuoi As Long
hang_cuoi = G_N.Range("B2").Value + 4

G_N.Range("B" & hang_cuoi).Value = G_N.Range("B1").Value

''''''''iN DU LIEU'''''''
On Error GoTo baoloi:
G_N.Select
ActiveWindow.SelectedSheets.PrintOut From:=1, to:=1, Copies:=1, Collate:=True

baoloi:

''''''''XOA DU LIEU'''''''

End Sub

Một bài đăng ở nhiều nơi là vi phạm Nội quy và sẽ bị xóa đó bạn à.

 

[Ldh1984]

Một bài đăng ở nhiều nơi là vi phạm Nội quy và sẽ bị xóa đó bạn à.

để mình xóa bài

 

[minhhung293]

"Khác" thì xóa có nghĩa là "Giống" thì lấy?

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 14).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 14)
For I = 1 To R
    If sArr(I, 14) = "V4B" Or sArr(I, 14) = "V4D" Then
        K = K + 1
        For J = 1 To 14
            dArr(K, J) = sArr(I, J)
        Next J
    End If
Next I
Range("A2").Resize(R, 14).ClearContents
Range("A2").Resize(K, 14) = dArr
End Sub

mình áp dụng code này khi chạy rất nhanh, nhưng có 1 lỗi là 2 cột ngày tháng bị đảo thứ tự: data là 01/10/2021, chạy xóa xong biến thành 10/01/2021, kể từ 13/10/2021 thì code chạy đúng, ai hỗ trợ giúp mình lỗi này với!!