Mong giúp đỡ tối ưu hoá vòng lặp code tự động điền ngày (1 người xem)

[AnhThu-1976]

Em có viết code tự động điền ngày Today() như sau
Trong sheet nếu trong cùng 1 dòng mà ô cột B trống và cột E khác trống thì điền ngày Today ở cột cột B

Sub TuDongDienNgay()
    Dim Lr As Long, i As Long
    Lr = Sheets("TH").Range("E" & Rows.Count).End(xlUp).Row
    For i = 9 To Lr
        If Cells(i, 5) <> "" And Cells(i, 2) = "" Then
            Cells(i, 2).Value = "=today()"
            Cells(i, 2).Value = Cells(i, 2).Value
        End If
    Next i
End Sub

code này đúng nhưng chạy hơi lâu (trong file em khoảng 1000 dòng mà chạy khoảng 8')
Mặt khác do 1 lúc chạy nhiều code kết hợp, nên chạy khá lâu
Em nhờ anh/chị giúp viết ở dạng mãng gì đó, để nó chạy nhanh hơn
Em cảm ơn!

 

[hoangtuaotrang_hp_vn]

Em có viết code tự động điền ngày Today() như sau
Trong sheet nếu trong cùng 1 dòng mà ô cột B trống và cột E khác trống thì điền ngày Today ở cột cột B

Sub TuDongDienNgay()
    Dim Lr As Long, i As Long
    Lr = Sheets("TH").Range("E" & Rows.Count).End(xlUp).Row
    For i = 9 To Lr
        If Cells(i, 5) <> "" And Cells(i, 2) = "" Then
            Cells(i, 2).Value = "=today()"
            Cells(i, 2).Value = Cells(i, 2).Value
        End If
    Next i
End Sub

code này đúng nhưng chạy hơi lâu (trong file em khoảng 1000 dòng mà chạy khoảng 8')
Mặt khác do 1 lúc chạy nhiều code kết hợp, nên chạy khá lâu
Em nhờ anh/chị giúp viết ở dạng mãng gì đó, để nó chạy nhanh hơn
Em cảm ơn!

Dùng chatGPT ta có code sau:

Sub TuDongDienNgay()
    Dim ws As Worksheet
    Dim Lr As Long, i As Long
    Dim Data As Variant

    ' Xác d?nh Sheet "TH"
    Set ws = Sheets("TH")

    ' Xác d?nh hàng cu?i cùng có d? li?u trong c?t E
    Lr = ws.Range("E" & ws.Rows.Count).End(xlUp).Row

    ' T?t c?p nh?t màn hình và tính toán t? d?ng d? tang t?c
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Ð?c d? li?u t? c?t E và c?t B vào m?ng
    Data = ws.Range("B9:E" & Lr).Value
    
    ' L?p qua m?ng và di?n ngày hi?n t?i vào c?t B n?u c?t E có d? li?u và c?t B tr?ng
    For i = 1 To UBound(Data, 1)
        If Data(i, 4) <> "" And Data(i, 1) = "" Then
            Data(i, 1) = Date
        End If
    Next i
    
    ' Ghi l?i m?ng dã thay d?i vào vùng d? li?u ban d?u
    ws.Range("B9:E" & Lr).Value = Data

    ' Khôi ph?c l?i tính toán t? d?ng và c?p nh?t màn hình
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[huhumalu]

Em có viết code tự động điền ngày Today()

Theo mình số liệu ngày tháng là cực kỳ nhạy cảm. Một lệnh chạy này có thể làm sai lệch số liệu, ngày hôm qua chạy, và ngày hôm nay chạy thì số liêu sai sạch.
Bản thân Today của ngày mai cũng nhảy số theo ngày mai ?
Hy vọng bạn đang không theo hướng quá lạm dụng VBA.

 

[AnhThu-1976]

Theo mình số liệu ngày tháng là cực kỳ nhạy cảm. Một lệnh chạy này có thể làm sai lệch số liệu, ngày hôm qua chạy, và ngày hôm nay chạy thì số liêu sai sạch.
Bản thân Today của ngày mai cũng nhảy số theo ngày mai ?
Hy vọng bạn đang không theo hướng quá lạm dụng VBA.

Mình có dựa bài hôm qua và viết như sau

Sub TuDongDienNgay_1()
Dim Lr As Long, i As Long, Rng As Range
    Sheets("TH").Select
    Lr = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
    If Lr <= 8 Then Exit Sub
    For i = 9 To Lr
        
        If Cells(i, 5) <> "" And Cells(i, 2) = "" Then
            If Rng Is Nothing Then
                Set Rng = Cells(i, 2)
            Else
                Set Rng = Union(Rng, Cells(i, 2))
            End If
        End If
    Next i
   
    Rng.Value = "=today()"
    Rng.Value = Rng.Value
End Sub

 

[Hoàng Tuấn 868]

Mong giúp đỡ tối ưu hoá vòng lặp code tự động điền ngày​

Em có viết code tự động điền ngày Today() như sau
Trong sheet nếu trong cùng 1 dòng mà ô cột B trống và cột E khác trống thì điền ngày Today ở cột cột B

Mình cứ thấy vụ nào có chữ "tối ưu" là chạy rẽ tóc luôn vì không biết tiêu chuẩn như thế nào được gọi là "tối ưu".

 

[cantl]

dạng mãng

của hoangtuaotrang nhanh như điện luôn ấy. TỐI ƯU với 500k dòng.