Giúp sửa code For Next thành công thức mãng cho nhanh

[hunglam123]

Chào tất cả thành viên GPE
Mình mới tập tành code nên có nhiều cái chưa hiểu cho lắm. Mình có dùng đoạn code này để xóa những dòng nào có mã ="0"

Sub xoadong()

Dim i As Long

    For i = 3 To 10000

        If Range("a" & i).Value = "0" Then

           Range("a" & i & ":e" & i).ClearContents

        End If

    Next i

    MsgBox ("xong")

End Sub

Mình thử chạy trên 10000 dòng code chạy khá lâu. Vậy cho mình hỏi nếu muốn viết sang dạng mãng thì phải làm sao. Mình xim cảm ơn .

 

[Excelpoint6688]

Haha, thử lại:

Sub xoa_dong2()

Dim i As Long, j As Long, lr As Long
Dim a As Variant
lr = Range("A" & Rows.Count).End(xlUp).Row
a = Range("A3:E" & lr).Value
    For i = 1 To UBound(a)
        If a(i, 1) = 0 Then
            For j = 1 To 5
                a(i, j) = ""
            Next
        End If
    Next i
Range("A3:E" & lr).Value = a
MsgBox ("Xong")

End Sub

Bạn ơi, không phải giá trị thành "", mà delete cả cái dòng trắng thì sửa code sao b nhỉ

 

[phuoclocvl]

Bạn ơi, không phải giá trị thành "", mà delete cả cái dòng trắng thì sửa code sao b nhỉ

Chào bạn,
Không chê thì dùng code này . Cảm ơn,

Option Explicit
Sub Delete_Row()
Application.Screenupdate=False
    Dim Arr(), sArr()
    Dim i As Long, j As Long, k As Long
    Dim lR As Long, Col As Long
    Dim sh As Worksheet
    Set sh = ThisWorkbook.ActiveSheet
        lR = sh.Range("A65000").End(xlUp).Row
        Col = sh.UsedRange.Columns(sh.UsedRange.Columns.Count).Column
        sArr = sh.Range(sh.Cells(1, 1), sh.Cells(lR, Col)).Value
        ReDim Arr(1 To UBound(sArr, 1), 1 To Col)
        For i = 1 To UBound(sArr, 1)
            If Val(sArr(i, 1)) <> 0 Then 'Nếu trong cột có chuỗi thì thay Val(sArr(i, 1)) => sArr(i, 1)
                k = k + 1
                For j = 1 To Col
                        Arr(k, j) = sArr(i, j)
                Next j
            End If
        Next i
    sh.Range(sh.Cells(1, 1), sh.Cells(lR, Col)).ClearContents
    sh.Range("A1").Resize(i - 1, j - 1) = Arr
    MsgBox ("OK ! (^_^)")
Application.Screenupdate=True
End Sub

 

[Excelpoint6688]

Chào bạn,
Không chê thì dùng code này . Cảm ơn,

Option Explicit
Sub Delete_Row()
    Dim Arr(), sArr()
    Dim i As Long, j As Long, k As Long
    Dim lR As Long, Col As Long
    Dim sh As Worksheet
    Set sh = ThisWorkbook.ActiveSheet
        lR = sh.Range("A65000").End(xlUp).Row
        Col = sh.UsedRange.Columns(sh.UsedRange.Columns.Count).Column
        sArr = sh.Range(sh.Cells(1, 1), sh.Cells(lR, Col)).Value
        ReDim Arr(1 To UBound(sArr, 1), 1 To Col)
        For i = 1 To UBound(sArr, 1)
            If Val(sArr(i, 1)) <> 0 Then 'Nếu trong cột có chuỗi thì thay Val(sArr(i, 1)) => sArr(i, 1)
                k = k + 1
                For j = 1 To Col
                        Arr(k, j) = sArr(i, j)
                Next j
            End If
        Next i
    sh.Range(sh.Cells(1, 1), sh.Cells(lR, Col)).ClearContents
    sh.Range("A1").Resize(i - 1, j - 1) = Arr
    MsgBox ("OK ! (^_^)")
End Sub

đc giúp sao dám chê , code chạy nhanh lắm, mình ko hiểu cái khai bảo Option Explicit để làm gì bạn nhỉ

 

[phuoclocvl]

đc giúp sao dám chê , code chạy nhanh lắm, mình ko hiểu cái khai bảo Option Explicit để làm gì bạn nhỉ

Cái đó là tất cả các biến trong code phải được khai báo chính xác. Tại mình thích vậy hihi
Cảm ơn,