Nhờ xử lý đoạn code copy công thức chạy nhanh hơn

[anhtotbung35]

Mình làm đoạn code FillDown (tự động copuy công thức xuống dòng dưới) như sau:
Dim strLastRow As Integer
strLastRow = xlLastRow("NKPS")
With Nhapchungtu
Sheets("NKPS").Cells(strLastRow + 1, 1).FillDown
Sheets("NKPS").Cells(strLastRow + 1, 2).FillDown
Sheets("NKPS").Cells(strLastRow + 1, 3).Value = .LCT
Sheets("NKPS").Cells(strLastRow + 1, 4).FillDown
Sheets("NKPS").Cells(strLastRow + 1, 5).Value = .SoCT.Value
Sheets("NKPS").Cells(strLastRow + 1, 6).Value = DateValue(NgayCT.Value)
Sheets("NKPS").Cells(strLastRow + 1, 7).Value = .MaHH.Text
Sheets("NKPS").Cells(strLastRow + 1, 8).Value = .Soluong.Value
Sheets("NKPS").Cells(strLastRow + 1, 9).FillDown
Sheets("NKPS").Cells(strLastRow + 1, 10).FillDown
Sheets("NKPS").Cells(strLastRow + 1, 11).Value = .Diengiai
Sheets("NKPS").Cells(strLastRow + 1, 12).FillDown
Sheets("NKPS").Cells(strLastRow + 1, 13).FillDown
Sheets("NKPS").Cells(strLastRow + 1, 14).Value = .SotienThu.Value
Sheets("NKPS").Cells(strLastRow + 1, 15).Value = .SotienNo.Value
Sheets("NKPS").Cells(strLastRow + 1, 16).Value = .Hoten
Sheets("NKPS").Cells(strLastRow + 1, 17).Value = .Diachi
Sheets("NKPS").Cells(strLastRow + 1, 18).Value = .Kho
Sheets("NKPS").Cells(strLastRow + 1, 19).Value = .Ghichu
Sheets("NKPS").Cells(strLastRow + 1, 20).Value = .Khachhang
On Error Resume Next
For i = 21 To 146 Step 1
Sheets("NKPS").Select
If i = 21 Then
Sheets("NKPS").Cells(strLastRow + 1, i).FillDown
Else
Sheets("NKPS").Cells(strLastRow + 1, i).FillDown
End If
Next i

strLastRow = strLastRow + 1

.LCT.Value = vbNullString
.SoCT.Value = vbNullString
.NgayCT.Value = vbNullString
.MaHH.Value = vbNullString
.Diengiai.Value = vbNullString
.Soluong.Value = vbNullString
.SotienThu.Value = vbNullString
.SotienNo.Value = vbNullString
.Khachhang.Value = vbNullString
.Hoten.Value = vbNullString
.Diachi.Value = vbNullString
.Kho.Value = vbNullString
.Ghichu.Value = vbNullString
End With

xlLastRow: là công thức tìm dòng cuối cùng của excell thôi.

Nhờ các bạn xem dùm có thể làm ngắn gọn hơn được nữa không, vì khi nhập liệu xong từ Form, click để ghi dữ liệu vào excell thì chờ lâu quá do copy tới 146 cột.

 

[sealand]

Đoạn Code sau hình như sai thì phải (2 vế lệnh If giống nhau), strLastRow = strLastRow + 1 thừa vì được xác định bằng hàm rồi và cũng chẳng để làm gì.

On Error Resume Next
    For i = 21 To 146 Step 1
        Sheets("NKPS").Select
        If i = 21 Then
            Sheets("NKPS").Cells(strLastRow + 1, i).FillDown
        Else
            Sheets("NKPS").Cells(strLastRow + 1, i).FillDown
        End If
        Next i
    
    strLastRow = strLastRow + 1

Cứ cho là đúng 2 câu lện này khác nhau thì phải viết thế này và bỏ vòng lặp đi

Sheets("NKPS").Cells(strLastRow + 1, 21).FillDown
Sheets("NKPS").Range(Cells(strLastRow + 1, 22),Cells(strLastRow + 1, 146)).FillDown

Ngoài ra, (mình chưa Test ) chưa chắc lệnh FillDown kiểu này sẽ nhanh hơn lệnh Copy. Mình thấy Copy hay FillDown rẹt cả 146 cột sau đó cập nhật lại những ô không chứa công thức là xong.
Lệnh của bạn nếu chạy rất có thể cập nhật lên dòng nguồn chứ không phải dòng cuối.
Nói chung, Code còn rút gọn nhiều nhưng không có file cụ thể nên không dám chắc.

 

[anhtotbung35]

Đoạn Code sau hình như sai thì phải (2 vế lệnh If giống nhau), strLastRow = strLastRow + 1 thừa vì được xác định bằng hàm rồi và cũng chẳng để làm gì.

On Error Resume Next
For i = 21 To 146 Step 1
Sheets("NKPS").Select
If i = 21 Then
Sheets("NKPS").Cells(strLastRow + 1, i).FillDown
Else
Sheets("NKPS").Cells(strLastRow + 1, i).FillDown
End If
Next i
 
strLastRow = strLastRow + 1

Cứ cho là đúng 2 câu lện này khác nhau thì phải viết thế này và bỏ vòng lặp đi

Sheets("NKPS").Cells(strLastRow + 1, 21).FillDown
Sheets("NKPS").Range(Cells(strLastRow + 1, 22),Cells(strLastRow + 1, 146)).FillDown

Ngoài ra, (mình chưa Test ) chưa chắc lệnh FillDown kiểu này sẽ nhanh hơn lệnh Copy. Mình thấy Copy hay FillDown rẹt cả 146 cột sau đó cập nhật lại những ô không chứa công thức là xong.
Lệnh của bạn nếu chạy rất có thể cập nhật lên dòng nguồn chứ không phải dòng cuối.
Nói chung, Code còn rút gọn nhiều nhưng không có file cụ thể nên không dám chắc.

Mình gửi file lên bạn xem dùm nhé. Nếu được bạn có thể giúp mình làm khi Click vào nút Nhap xong, code chạy nhanh hơn. File này mình đã xóa bớt các sheet link dữ liệu và chỉ thực hiện FillDown 46 cột thôi cho nhẹ dung lượng mới upload lên diễn đàn được. Chứ thực tế khi Click nhập xong thì chạy cũng chậm lắm do tới 146 cột.