Cải thiện code vba thêm dòng mới sau mỗi 10 dòng

Ngân Nguyễn 9x · 21/3/23

Dạ em có đoạn code sau, cứ sau mỗi 10 dòng em lại chèn thêm 1 dòng trống. Hiện code này đang đúng song vẫn chạy khá chậm nếu số lượng dòng lớn, các anh chị giúp em tối ưu với ạ, e cảm ơn nhiều nhiều ạ.

Sub AddRowsEvery10()
Dim a, b As Double
Dim i As Integer
Dim rowCount As Integer

rowCount = Sheet1.UsedRange.Rows.Count

a = Timer
Application.DisplayAlerts = False
Application.ScreenUpdating = False

For i = 10 To rowCount Step 10
Rows(i + 1).Insert
Next i

b = Timer
Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox Round(b - a, 2)
End Sub

SA_DQ · 21/3/23

Bạn đang có 2 000 dòng có DL (dữ liệu); Được cái là DL là số tăng dần rất chi là đều
Chương trình của bạn đã tạo vòng lặp 200 lần để thêm 200 dòng trắng;
[Điều kiện là trang tính này sẽ còn các cột DL khác]
Mình nghỉ 1 cách khác: Cũng xài 1 vòng lặp 206 nhưng thay vì thêm dòng ta cải biên:
Bắt đầu từ dòng cuối cùng có DL +1 trở đi ta quýnh các số 10, 20, . . . . 200
Tiến hành xếp theo chiều tăng dần của cột này

Bạn thử xem cách làm nào nhanh hơn đi nha.

Ngân Nguyễn 9x · 21/3/23

SA_DQ đã viết:
Bạn đang có 2 000 dòng có DL (dữ liệu); Được cái là DL là số tăng dần rất chi là đều
Chương trình của bạn đã tạo vòng lặp 200 lần để thêm 200 dòng trắng;
[Điều kiện là trang tính này sẽ còn các cột DL khác]
Mình nghỉ 1 cách khác: Cũng xài 1 vòng lặp 206 nhưng thay vì thêm dòng ta cải biên:
Bắt đầu từ dòng cuối cùng có DL +1 trở đi ta quýnh các số 10, 20, . . . . 200
Tiến hành xếp theo chiều tăng dần của cột này

Bạn thử xem cách làm nào nhanh hơn đi nha.

dạ e cảm ơn a nhiều ạ

VetMini · 21/3/23

Đã là dân code thì nên tập viết từ cho rõ. Quen viết tắt chỉ có hai về sau.

Code chỉ có thể cải thiện được một chút như sau:
(chú ý: insert thì phphaitwf dưới lên tren chứ từ trên xuống thì số dòng sai hết.)

Sub AddRowsEvery10()
Dim t as Double
Dim i As Integer
Dim SvAlrt, SvScrn, SvCalc
SvAlrt = Application.DisplayAlerts
SvScrn = Application.ScreenUpdating
SvCalc = Application.Calculation
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
t = Timer
For i = (Sheet1.UsedRange.Rows.Count \ 10) + 1 To 11 Step -10
Rows(i).Insert
Next i
t = Timer - t
Application.ScreenUpdating = SvScrn
Application.DisplayAlerts = SvAlrt
Application.Calculation = SvCalc
MsgBox Round(t, 2)
End Sub

Cách khá hơn một chutsn là Union các chỗ cần insert lại và llàm một lượt.

Tuye nhiên, Insert dòng luôn luôn chậm.
Vì vậy chỉ có thể thay đổi giải thuật chứ khó thay đổi code.

Giải thuật khác (làm tay cũng được mà code cũng được):
1. Tạo một cột phụ
2. Trong cột phụ, đánh số từ 1 đến n
3. Sau dòng cuỗi, tiếp tục đánh sô 10.1, 20.1, 30.1,...
4. Sort theo cột phụ.
5. Xóa cột phụ
6. Hết

Ngân Nguyễn 9x · 21/3/23

VetMini đã viết:
Đã là dân code thì nên tập viết từ cho rõ. Quen viết tắt chỉ có hai về sau.

Code chỉ có thể cải thiện được một chút như sau:
(chú ý: insert thì phphaitwf dưới lên tren chứ từ trên xuống thì số dòng sai hết.)

Sub AddRowsEvery10()
Dim t as Double
Dim i As Integer
Dim SvAlrt, SvScrn, SvCalc
SvAlrt = Application.DisplayAlerts
SvScrn = Application.ScreenUpdating
SvCalc = Application.Calculation
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
t = Timer
For i = (Sheet1.UsedRange.Rows.Count \ 10) + 1 To 11 Step -10
Rows(i).Insert
Next i
t = Timer - t
Application.ScreenUpdating = SvScrn
Application.DisplayAlerts = SvAlrt
Application.Calculation = SvCalc
MsgBox Round(t, 2)
End Sub

Cách khá hơn một chutsn là Union các chỗ cần insert lại và llàm một lượt.

Tuye nhiên, Insert dòng luôn luôn chậm.
Vì vậy chỉ có thể thay đổi giải thuật chứ khó thay đổi code.

Giải thuật khác (làm tay cũng được mà code cũng được):
1. Tạo một cột phụ
2. Trong cột phụ, đánh số từ 1 đến n
3. Sau dòng cuỗi, tiếp tục đánh sô 10.1, 20.1, 30.1,...
4. Sort theo cột phụ.
5. Xóa cột phụ
6. Hết

Dạ e cảm ơn a nhiều ạ, a chỉ rất chi tiết

VetMini · 22/3/23

Ngân Nguyễn 9x đã viết:
Dạ e cảm ơn a nhiều ạ, a chỉ rất chi tiết

Thà chửi tôi chứ đừng dùng cái loại ngôn ngữ viết tắt này với tôi.
Người chung quanh, bạn bè tôi mà biết tôi nói chuyện với dân viết tắt chúng sẽ khi dễ tôi.

diepvienvss · 22/3/23

VetMini đã viết:
Đã là dân code thì nên tập viết từ cho rõ. Quen viết tắt chỉ có hai về sau.

Code chỉ có thể cải thiện được một chút như sau:
(chú ý: insert thì phphaitwf dưới lên tren chứ từ trên xuống thì số dòng sai hết.)

Sub AddRowsEvery10()
Dim t as Double
Dim i As Integer
Dim SvAlrt, SvScrn, SvCalc
SvAlrt = Application.DisplayAlerts
SvScrn = Application.ScreenUpdating
SvCalc = Application.Calculation
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
t = Timer
For i = (Sheet1.UsedRange.Rows.Count \ 10) + 1 To 11 Step -10
Rows(i).Insert
Next i
t = Timer - t
Application.ScreenUpdating = SvScrn
Application.DisplayAlerts = SvAlrt
Application.Calculation = SvCalc
MsgBox Round(t, 2)
End Sub

Cách khá hơn một chutsn là Union các chỗ cần insert lại và llàm một lượt.

Tuye nhiên, Insert dòng luôn luôn chậm.
Vì vậy chỉ có thể thay đổi giải thuật chứ khó thay đổi code.

Giải thuật khác (làm tay cũng được mà code cũng được):
1. Tạo một cột phụ
2. Trong cột phụ, đánh số từ 1 đến n
3. Sau dòng cuỗi, tiếp tục đánh sô 10.1, 20.1, 30.1,...
4. Sort theo cột phụ.
5. Xóa cột phụ
6. Hết

Viết cũng sai chính tả

Maika8008 · 22/3/23

Ngân Nguyễn 9x đã viết:
Dạ em có đoạn code sau, cứ sau mỗi 10 dòng em lại chèn thêm 1 dòng trống. Hiện code này đang đúng song vẫn chạy khá chậm nếu số lượng dòng lớn, các anh chị giúp em tối ưu với ạ, e cảm ơn nhiều nhiều ạ.

Sub AddRowsEvery10()
Dim a, b As Double
Dim i As Integer
Dim rowCount As Integer

rowCount = Sheet1.UsedRange.Rows.Count

a = Timer
Application.DisplayAlerts = False
Application.ScreenUpdating = False

For i = 10 To rowCount Step 10
Rows(i + 1).Insert
Next i

b = Timer
Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox Round(b - a, 2)
End Sub

Sửa lại code chút xíu:

Rich (BB code):

Sub AddRowsEvery10()
    Dim a, b As Double
    Dim i As Integer
    Dim rowCount As Integer, Rng As Range
    
    rowCount = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    
    a = Timer
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For i = 10 To rowCount Step 10
        If Rng Is Nothing Then
            Set Rng = Rows(i + 1)
        Else
            Set Rng = Union(Rng, Rows(i + 1))
        End If
    Next i
    Rng.Insert
    b = Timer
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox Round(b - a, 2)
End Sub

hoangexcell · 22/3/23

VetMini đã viết:
Thà chửi tôi chứ đừng dùng cái loại ngôn ngữ viết tắt này với tôi.
Người chung quanh, bạn bè tôi mà biết tôi nói chuyện với dân viết tắt chúng sẽ khi dễ tôi.

Bác khó tính đi đâu cũng khó tính vậy à. Viết tắt cho nó nhanh tí thôi mà.
Nhớ mấy năm trước đâu có khó vậy đâu ta, tầm 2019-20 chớ mấy !

bebo021999 · 22/3/23

Tối quá, tình cờ buồn buồn vọc chơi, cho 20.000 dòng, chạy code ở bài #8, ngủ quên, sáng nay mở mắt kiểm tra thấy code vẫn còn chạy.
Chạy thử code dưới đây thấy khá khẩm hơn 1 chút.

PHP:

Sub test()
Dim lr As Double, i As Double, t
t = Timer
lr = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
With Range("ZZ2:ZZ" & lr)
    .Formula = "=1/MOD(ROW()-1,10)"
    .Value = .Value
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Insert
End With
Columns("ZZ").ClearContents
[A1].Select
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

HeSanbi · 22/3/23

Ngân Nguyễn 9x

Sử dụng Hàm Union gộp Range, để tiết kiệm tài nguyên bạn nhé
Tốt nhất nên khai báo ô bắt đầu.

JavaScript:

Sub AddRowsEvery10()
  Dim a, i%, rowCount&, rg As Range, cell As Range
  Set cell = Sheet1.Range("A1")
  rowCount = cell.parent.UsedRange.Rows.count - cell.row + 1
  a = Timer
  With Application: .DisplayAlerts = False: .ScreenUpdating = False: .EnableEvents = False
    '------------------------------------
    For i = 11 To rowCount Step 10
      If Not rg Is Nothing Then Set rg = Union(rg, cell(i, 1)) Else Set rg = cell(i, 1)
    Next i
    If Not rg Is Nothing Then
      rg.EntireRow.Insert: MsgBox "Insert complete: " & Round(Timer - a, 2)
    Else
      MsgBox "Rows Empty!"
    End If
    '------------------------------------
    .DisplayAlerts = True: .ScreenUpdating = True: .EnableEvents = True
  End With
 
End Sub

befaint · 22/3/23

Maika8008 đã viết:
Set Rng = Union(Rng, Rows(i + 1))

Union đúng là chỉ kha khá hơn tí tẹo mà thôi anh. Và nó chỉ khá hơn khi làm việc với số lượng ít, nhiều là sập toàn thiên nhiên, bò tới vài mùa quýt chín =]]]
(như bài #10 dẫn chứng).

Bài này chỉ có cách dùng cột phụ và sort (như bài #4 đã nêu), hoặc dùng Array.

Maika8008 đã viết:
If Rng Is Nothing Then

Nhân tiện vụ này, hóa ra sau bao nhiêu năm vẫn chưa thấy có ai tìm ra kỹ thuật bỏ qua cái If này. Híc.

Maika8008 · 22/3/23

bebo021999 đã viết:
Tối quá, tình cờ buồn buồn vọc chơi, cho 20.000 dòng, chạy code ở bài #8, ngủ quên, sáng nay mở mắt kiểm tra thấy code vẫn còn chạy.
Chạy thử code dưới đây thấy khá khẩm hơn 1 chút.

PHP:

Sub test() Dim lr As Double, i As Double, t t = Timer lr = Cells(Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False With Range("ZZ2:ZZ" & lr) .Formula = "=1/MOD(ROW()-1,10)" .Value = .Value .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Insert End With Columns("ZZ").ClearContents [A1].Select Application.ScreenUpdating = True MsgBox Timer - t End Sub

Code bài #8 trên máy tôi chạy 20.000 dòng mất chừng 35 giây. Tuy nhiên với 40.000 dòng thì lâu quá, tôi chưa chờ thủ mất bao lâu.

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

befaint đã viết:
Union đúng là chỉ kha khá hơn tí tẹo mà thôi anh. Và nó chỉ khá hơn khi làm việc với số lượng ít, nhiều là sập toàn thiên nhiên, bò tới vài mùa quýt chín =]]]
(như bài #10 dẫn chứng).

Bài này chỉ có cách dùng cột phụ và sort (như bài #4 đã nêu), hoặc dùng Array.

Nhân tiện vụ này, hóa ra sau bao nhiêu năm vẫn chưa thấy có ai tìm ra kỹ thuật bỏ qua cái If này. Híc.

Dùng Array thì nhanh nhưng sẽ phá hết công thức (nếu có)
Còn vụ if kia quả thực là chưa có gì thay thế cho gọn hết hả bạn?

VetMini · 22/3/23

hoangexcell đã viết:
Bác khó tính đi đâu cũng khó tính vậy à. Viết tắt cho nó nhanh tí thôi mà.
Nhớ mấy năm trước đâu có khó vậy đâu ta, tầm 2019-20 chớ mấy !

Nhớ tầm bậy rồi tuyên bố nhảm!!!
Ở đây ai cũng biết tôi luôn giữ vững lạp trường. Chỉ mình bạn cố tình xuyên tạc.

Dân quen viết tắt thì cũng có thói chủ quan và cẩu thả.
Ở nài #4 tôi có nói rõ là dân lập trình không nên theo thói viết tắt.
Ở bài #3, thớt trả lời bằng câu với mấy từ viết tắt:
1. Thớt cố tình bẽ mặt tôi, hoăc
2. Không cố tình, chỉ do tính chủ quan và cẩu thả

hoangexcell · 22/3/23

VetMini đã viết:
Nhớ tầm bậy rồi tuyên bố nhảm!!!
Ở đây ai cũng biết tôi luôn giữ vững lạp trường. Chỉ mình bạn cố tình xuyên tạc.

Dân quen viết tắt thì cũng có thói chủ quan và cẩu thả.
Ở nài #4 tôi có nói rõ là dân lập trình không nên theo thói viết tắt.
Ở bài #3, thớt trả lời bằng câu với mấy từ viết tắt:
1. Thớt cố tình bẽ mặt tôi, hoăc
2. Không cố tình, chỉ do tính chủ quan và cẩu thả

Ô thế mình đang hiểu nhầm à. Theo bài tới đoạn như hình thì nghĩ là bắt bẽ chữ viết tắt: a thay cho Anh!
Nếu không phải thế thì thôi nhé. Xí xóa nhé!

VetMini · 22/3/23

befaint đã viết:
Union đúng là chỉ kha khá hơn tí tẹo mà thôi anh. Và nó chỉ khá hơn khi làm việc với số lượng ít, nhiều là sập toàn thiên nhiên, bò tới vài mùa quýt chín =]]]
(như bài #10 dẫn chứng).

Bài này chỉ có cách dùng cột phụ và sort (như bài #4 đã nêu), hoặc dùng Array.

Nhân tiện vụ này, hóa ra sau bao nhiêu năm vẫn chưa thấy có ai tìm ra kỹ thuật bỏ qua cái If này. Híc.

Ở bài #4 tôi có d ẫn các cách phụ của Delete, kể cả Union.
Trong bài ấy cũng cho biết là nguyên tắc Delete thì phải từ dưới lên trên. Tôi chỉ thấy code của thớt rác quá nên không buồn nêu ra là nó sai - không chỉ kém hiệu quả.

Những bất lợi của Union có thể cải tiến nếu biết kỹ thuật "chia để trị".

Ở bài ấy, tôi cũng có nói rằng Delete là giải pháp kém hiueej quả nhất.

Tôi không đề cập đến chuyện chép ra Array là vì phuonwg pháp này có rất nhiều ràng buộc.

Trước mắt thì phường pháp cột phụ và sort là khả quan nhất.
Bài này cũng dễ, dùng hàm Evaluate với công thức đơn giản đẻ ghi cột phụ rất nhanh.

bebo021999 · 22/3/23

VetMini đã viết:
Trước mắt thì phường pháp cột phụ và sort là khả quan nhất.
Bài này cũng dễ, dùng hàm Evaluate với công thức đơn giản đẻ ghi cột phụ rất nhanh.

Như bài #10 đang dùng cột phụ ZZ đó ạ. Tốc độ cũng tương đối.

Ngân Nguyễn 9x · 22/3/23

hoangexcell đã viết:
View attachment 287873

Ô thế mình đang hiểu nhầm à. Theo bài tới đoạn như hình thì nghĩ là bắt bẽ chữ viết tắt: a thay cho Anh!
Nếu không phải thế thì thôi nhé. Xí xóa nhé!

Anh cho em xin lỗi nhé, khổ thân bé. Bé mới vào diễn đàn bị các anh mắng te tua. Em sẽ rút kinh nghiệm nè

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

Maika8008 đã viết:
Code bài #8 trên máy tôi chạy 20.000 dòng mất chừng 35 giây. Tuy nhiên với 40.000 dòng thì lâu quá, tôi chưa chờ thủ mất bao lâu.

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

Dùng Array thì nhanh nhưng sẽ phá hết công thức (nếu có)
Còn vụ if kia quả thực là chưa có gì thay thế cho gọn hết hả bạn?

Dạ cảm ơn anh nhiều ạ

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

bebo021999 đã viết:
Như bài #10 đang dùng cột phụ ZZ đó ạ. Tốc độ cũng tương đối.

Dạ em cũng nghĩ tới bước dùng cột phụ rồi mà nếu dùng cột phụ em cũng sẽ dùng vba để đánh số nên cũng mất nhiều thời gian

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

Maika8008 đã viết:

Sửa lại code chút xíu:

Rich (BB code):

Sub AddRowsEvery10()
    Dim a, b As Double
    Dim i As Integer
    Dim rowCount As Integer, Rng As Range
   
    rowCount = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
   
    a = Timer
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
    For i = 10 To rowCount Step 10
        If Rng Is Nothing Then
            Set Rng = Rows(i + 1)
        Else
            Set Rng = Union(Rng, Rows(i + 1))
        End If
    Next i
    Rng.Insert
    b = Timer
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox Round(b - a, 2)
End Sub

Union là một cách mới đối với em, cảm ơn anh ạ

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

HeSanbi đã viết:

Ngân Nguyễn 9x

Sử dụng Hàm Union gộp Range, để tiết kiệm tài nguyên bạn nhé
Tốt nhất nên khai báo ô bắt đầu.

JavaScript:

Sub AddRowsEvery10()
  Dim a, i%, rowCount&, rg As Range, cell As Range
  Set cell = Sheet1.Range("A1")
  rowCount = cell.parent.UsedRange.Rows.count - cell.row + 1
  a = Timer
  With Application: .DisplayAlerts = False: .ScreenUpdating = False: .EnableEvents = False
    '------------------------------------
    For i = 11 To rowCount Step 10
      If Not rg Is Nothing Then Set rg = Union(rg, cell(i, 1)) Else Set rg = cell(i, 1)
    Next i
    If Not rg Is Nothing Then
      rg.EntireRow.Insert: MsgBox "Insert complete: " & Round(Timer - a, 2)
    Else
      MsgBox "Rows Empty!"
    End If
    '------------------------------------
    .DisplayAlerts = True: .ScreenUpdating = True: .EnableEvents = True
  End With
 
End Sub

Dạ em cảm ơn nhiều nhiều ạ

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

Tuyệt vời quá các anh, mọi người có nhiều cách hay ghê

Cải thiện code vba thêm dòng mới sau mỗi 10 dòng

Thành viên mới

File đính kèm

/(hông là gì!

Thành viên mới

Ăn cùng góc phố

Thành viên mới

Ăn cùng góc phố

Thành viên mới

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên gạo cội

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Ngân Nguyễn 9x​

|||||||||||||

Thành viên gạo cội

Ăn cùng góc phố

Thành viên tiêu biểu

Ăn cùng góc phố

Thành viên gạo cội

Thành viên mới

Ngân Nguyễn 9x​

Ngân Nguyễn 9x

Ngân Nguyễn 9x