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

hunglam123 · 31/3/20

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"

Mã:

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 .

phuoclocvl · 31/3/20

hunglam123 đã viết:
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"

Mã:

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 .
View attachment 234398

Clear data mà cũng phải chuyển Array nữa hả?

Phuocam · 31/3/20

Thử:

PHP:

Sub xoa_dong()

Dim i As Long, lr As Long
Dim r As Range
'On Error Resume Next
lr = Range("A" & Rows.Count).End(xlUp).Row

    For i = 3 To lr
        If Range("A" & i).Value = 0 Then
            If r Is Nothing Then
                Set r = Range("A" & i).Resize(1, 5)
            Else
                Set r = Union(Range("A" & i).Resize(1, 5), r)
            End If
        End If
    Next i
    
    r.ClearContents
    MsgBox ("xong")

End Sub

.

excel_lv1.5 · 31/3/20

hunglam123 đã viết:
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"

Mã:

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 .
View attachment 234398

Bạn đưa nguyên cái bảng này vào mảng, rồi chạy vòng lặp lấy những cái <>0 cho vào mảng mới, rồi dán mảng mới đó lại bảng tính sẽ nhanh hơn

phuoclocvl · 31/3/20

Mình thì cũng ăn hại lắm nên nghĩ sao viết vậy. bạn thử coi sao

Sub xoadong()
Dim Arr(), rArr()
Dim i As Long
Dim k As Integer
Dim lR As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.ActiveSheet
lR = sh.Range("A65000").End(xlUp).Row
Arr = sh.Range("A1:E" & lR).Value
ReDim rArr(1 To lR, 1 To 100)
For i = 1 To UBound(Arr, 1)
If Arr(i, 1) <> 0 Then
k = k + 1
rArr(k, 1) = Arr(i, 1)
rArr(k, 2) = Arr(i, 2)
rArr(k, 3) = Arr(i, 3)
rArr(k, 4) = Arr(i, 4)
End If
Next i
sh.Range("A:E").ClearContents
sh.Range("A1").Resize(k, 5) = rArr
MsgBox ("xong")
End Sub

hunglam123 · 31/3/20

phuoclocvl đã viết:
Mình thì cũng ăn hại lắm nên nghĩ sao viết vậy. bạn thử coi sao

Sub xoadong()
Dim Arr(), rArr()
Dim i As Long
Dim k As Integer
Dim lR As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.ActiveSheet
lR = sh.Range("A65000").End(xlUp).Row
Arr = sh.Range("A1:E" & lR).Value
ReDim rArr(1 To lR, 1 To 100)
For i = 1 To UBound(Arr, 1)
If Arr(i, 1) <> 0 Then
k = k + 1
rArr(k, 1) = Arr(i, 1)
rArr(k, 2) = Arr(i, 2)
rArr(k, 3) = Arr(i, 3)
rArr(k, 4) = Arr(i, 4)
End If
Next i
sh.Range("A:E").ClearContents
sh.Range("A1").Resize(k, 5) = rArr
MsgBox ("xong")
End Sub

cảm ơn bạn. ý mình là chỉ xóa thôi. Và vị trí nào vẫn năm yên vị trí đó không cần lọc ra. Kiểu như vầy

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

excel_lv1.5 đã viết:
Bạn đưa nguyên cái bảng này vào mảng, rồi chạy vòng lặp lấy những cái <>0 cho vào mảng mới, rồi dán mảng mới đó lại bảng tính sẽ nhanh hơn

dạ hiện tại em chỉ biết cơ bản ( IF, For next, ) Nói chung cũng học lõm trên diển đàn. cái mãng em chưa biết Anh ơi

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

phuocam đã viết:

Thử:

PHP:

Sub xoa_dong()

Dim i As Long, lr As Long
Dim r As Range
'On Error Resume Next
lr = Range("A" & Rows.Count).End(xlUp).Row

    For i = 3 To lr
        If Range("A" & i).Value = 0 Then
            If r Is Nothing Then
                Set r = Range("A" & i).Resize(1, 5)
            Else
                Set r = Union(Range("A" & i).Resize(1, 5), r)
            End If
        End If
    Next i
   
    r.ClearContents
    MsgBox ("xong")

End Sub

.

thử test rồi .tốc độ nó y chang For next khi nhiều dòng bạn ơi

phuoclocvl · 31/3/20

Chào bạn
thử cái này coi

Sub xoadong()
Dim Arr(), rArr()
Dim i As Long, j As Long
Dim 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
Arr = sh.Range(sh.Cells(1, 1), sh.Cells(lR, Col)).Value
For i = 1 To UBound(Arr, 1)
For j = 1 To 5
If Val(Arr(i, 1)) = 0 Then
Arr(i, j) = ""
End If
Next j
Next i
sh.Range("A:E").ClearContents
sh.Range("A1").Resize(i - 1, j - 1) = Arr
MsgBox ("xong")
End Sub

hunglam123 · 31/3/20

phuoclocvl đã viết:
Chào bạn
thử cái này coi

Sub xoadong()
Dim Arr()
Dim i As Long, j As Long
Dim k As Long
Dim lR As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.ActiveSheet
lR = sh.Range("A65000").End(xlUp).Row
Arr = sh.Range("A1:E" & lR).Value
For i = 1 To UBound(Arr, 1)
For j = 1 To 5
If Val(Arr(i, 1)) = 0 Then
k = k + 1
Arr(i, j) = ""
End If
Next j
Next i
sh.Range("A:E").ClearContents
sh.Range("A1").Resize(k, 5) = Arr
MsgBox ("xong")
End Sub

Code nhanh hơn hẳn luôn cảm ơn bạn. mà sao nó mẩy chữ Name ở phía dưới là sao vậy bạn

phuoclocvl · 31/3/20

hunglam123 đã viết:
Code nhanh hơn hẳn luôn cảm ơn bạn. mà sao nó mẩy chữ Name ở phía dưới là sao vậy bạn
View attachment 234403

Mình sửa lại rồi á, bạn copy vô lại nhâ

PHP:

    Sub xoadong()

        Dim Arr()

        Dim i As Long, j 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

            Arr = sh.Range(sh.Cells(1, 1), sh.Cells(lR, Col)).Value

            For i = 1 To UBound(Arr, 1)

            For j = 1 To Col

                If Val(Arr(i, 1)) = 0 Then

                     Arr(i, j) = ""

                End If

            Next j

            Next i

            sh.Range("A1").Resize(i - 1, j - 1) = Arr

            MsgBox ("xong")

        End Sub

Ba Tê · 31/3/20

phuoclocvl đã viết:
For j = 1 To col
If Val(Arr(i, 1)) = 0 Then
Arr(i, j) = ""

Nếu 10.000 dòng x 5 cột thì phải xét IF 50.000 lần?

excel_lv1.5 đã viết:
Bạn đưa nguyên cái bảng này vào mảng, rồi chạy vòng lặp lấy những cái <>0 cho vào mảng mới, rồi dán mảng mới đó lại bảng tính sẽ nhanh hơn

Chỉ cần 1 mảng, xét nếu =0 thì xóa dữ liệu trong dòng đó.
Gán mảng đó trở lại sheet.

phuoclocvl · 31/3/20

Ba Tê đã viết:
Nếu 10.000 dòng x 5 cột thì phải xét IF 50.000 lần?

Anh ơi sửa cho bạn ấy đi, em chỉ biết vậy à. Cảm ơn anh

PacificPR · 31/3/20

Dùng Filter cột A với 0. Xóa cái bụp thế là xong

Phuocam · 31/3/20

Haha, thử lại:

PHP:

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

VetMini · 31/3/20

PacificPR đã viết:
Dùng Filter cột A với 0. Xóa cái bụp thế là xong

Phải record macro cho đến lúc xoá xong.
Sau đó, Ctrl+z để nó ra trở lại.
Thực hiện macro

.

truongvu317 · 31/3/20

PacificPR đã viết:
Dùng Filter cột A với 0. Xóa cái bụp thế là xong

Cảm ơn muội đã chia sẻ, cơ mà ạnh không biết viết sao cho đúng

VetMini · 31/3/20

truongvu317 đã viết:
Cảm ơn muội đã chia sẻ, cơ mà ạnh không biết viết sao cho đúng

Tại thớt dùng clear thẳng trên sheet mà không tắt ScreenUpdating cho nên nó chạm mạch. Chứ 10000 dòng (tuy là hàng khủng) cũng đâu có khó lắm.

Ba yếu tố:
- tắt chức năng ScreenUpdating
- Set range rồi Offset nó. Chứ mỗi lần tính lại địa chỉ hơi tốn công sức.
- Thường thì nên xoá từ dưới lên trên

svScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
Set rg = Range(A10000:E10000)
For i = 3 To 10000
IF rg.Cells(1) = 0 Then rg.ClearContents
Set rg = rg.Offset(-1)
Next i
Application.ScreenUpdating = svScreenUpdating

hunglam123 · 31/3/20

PacificPR đã viết:
Dùng Filter cột A với 0. Xóa cái bụp thế là xong

Vừa thử cách này của bạn. Thấy nhanh gọn lẹ nhất dể hiểu nhất. Nhưng có điều nếu chạy code 2 lần là nó xóa hết cái bảng luôn. Mặc dù cột giá trị không phải là 0 nó cũng xóa sạch hết luôn

Mã:

Sub Macro1()

Range("A3:E3").AutoFilter
Range("a3:e6000").AutoFilter Field:=1, Criteria1:="0"
Range("a3:e6000").ClearContents
Range("a3:e6000").AutoFilter Field:=1
Range("A3:E3").AutoFilter
 
End Sub

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

truongvu317 đã viết:
Cảm ơn muội đã chia sẻ, cơ mà ạnh không biết viết sao cho đúng

Mình thu macro vầy nek bạn

Mã:

Sub Macro1()

Range("A3:E3").AutoFilter
Range("a3:e6000").AutoFilter Field:=1, Criteria1:="0"
Range("a3:e6000").ClearContents
Range("a3:e6000").AutoFilter Field:=1
Range("A3:E3").AutoFilter
 
End Sub

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

phuocam đã viết:

Haha, thử lại:

PHP:

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

code chạy nhanh chóng mặt luôn. cảm ơn bạn

truongvu317 · 31/3/20

VetMini đã viết:
Set range rồi Offset nó. Chứ mỗi lần tính lại địa chỉ hơi tốn công sức.

dùng kiểu rng.cells(lngrow,1) thì có nhanh bằng offset không sư phụ Vẹt nhỏ.

VetMini · 31/3/20

hunglam123 đã viết:
...code chạy nhanh chóng mặt luôn. cảm ơn bạn

Dóc tổ, code chạy nhanh thì có thấy được đâu mà chóng mặt.
Ngược lại, nếu mà thấy được nó ghi từng dữ liệu thì nó phải tương đối chậm.

hunglam123 · 31/3/20

VetMini đã viết:
Dóc tổ, code chạy nhanh thì có thấy được đâu mà chóng mặt.
Ngược lại, nếu mà thấy được nó ghi từng dữ liệu thì nó phải tương đối chậm.

dạ em chỉ nói vui thôi anh. hihi

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

Thành viên bị đình chỉ hoạt động

File đính kèm

Thành viên thường trực

Thành viên mới

Thành viên tích cực

Thành viên thường trực

Thành viên bị đình chỉ hoạt động

Thành viên thường trực

Thành viên bị đình chỉ hoạt động

File đính kèm

Thành viên thường trực

Cạo Rồi Khỏi Gội

Thành viên thường trực

Thành viên mới

Thành viên mới

Ăn cùng góc phố

Thành viên tích cực

Ăn cùng góc phố

Thành viên bị đình chỉ hoạt động

Thành viên tích cực

Ăn cùng góc phố

Thành viên bị đình chỉ hoạt động

Facebook

Group