Tối ưu Replace trong VBA

LEHOC · 14/9/19

Em chào các anh/chị!
Em xin nhờ các anh/chị chỉ em cách nào để tối ưu đoạn code sau hay có giải pháp nào để giảm thời gian run với ạ.
Em cảm ơn

PHP:

Sub ReplaceRng()
Dim Sh, rng, Lr, i
Set Sh = ActiveSheet
Lr = Sh.Cells(Sh.Rows.Count, "B").End(xlUp).Row 'Lr = 80
Set rng = Sh.Range("B7:B" & Lr)
Sh.Range("B7:C" & Lr).Value = Sh.Range("B7:C" & Lr).Value
With rng
    Dim LrRngReplace
    LrRngReplace = Sheet3.Cells(Sheet3.Rows.Count, "K").End(xlUp).Row
    For i = 2 To LrRngReplace 'LrRngReplace = 29
        .Replace Sheet3.Range("K" & i).Value, Sheet3.Range("L" & i).Value, LookAt:=xlPart, SearchOrder:=xlByColumns
    Next i
End With
End Sub

leonguyenz · 14/9/19

Cách tốt hơn là đưa vào mảng.
Nên khai báo biến tường minh.

VetMini · 14/9/19

LEHOC đã viết:
... giải pháp nào để giảm thời gian run với ạ.
...

Mặc áo ấm hoặc mở máy sưởi.

batman1 · 14/9/19

VetMini đã viết:
Mặc áo ấm hoặc mở máy sưởi.

Run ở đây không dính dáng gì tới nhiệt độ đâu bác nhé. Vì đây là "làm bài" nên VBA run là do nó không tự tin. Vậy để nó tự tin thì tuồn "phao" vào cho nó thôi.

LEHOC · 15/9/19

VetMini đã viết:
Mặc áo ấm hoặc mở máy sưởi.

batman1 đã viết:
Run ở đây không dính dáng gì tới nhiệt độ đâu bác nhé. Vì đây là "làm bài" nên VBA run là do nó không tự tin. Vậy để nó tự tin thì tuồn "phao" vào cho nó thôi.

Bác có "phao" chỉ giáo em với ạ.
Em cảm ơn!

Bài đã được tự động gộp: 15/9/19

leonguyenz đã viết:
Cách tốt hơn là đưa vào mảng.
Nên khai báo biến tường minh.

Anh có thể cho em xin ví dụ không?

batman1 · 16/9/19

LEHOC đã viết:
Bác có "phao" chỉ giáo em với ạ.

Thực ra tôi không hứng. Nhưng nếu muốn người khác viết hộ code thì cũng nên đính kèm tập tin. Chả nhẽ viết chay không test? Con người nhiều khi phạm những lỗi rất đơn giản, vd. viết nhầm, viết thừa dấu chấm dấu phẩy. Không có tập tin thì test thế nào?
-----
Mà tốt nhất là mô tả kỹ bạn cần làm gì. Chưa chắc code của bạn làm đúng yêu cầu.

Tôi cho ví dụ. Giả sử trong sheet hiện hành chỉ có ô B7 <> rỗng và B7 = "anh". Giả sử sheet3 chỉ có dữ liệu K2 = "a", K3 = "th", K4 = "n", L2 = "thí", L3 = "ch", L4 = "c"

Sau vòng For 1 có B7 = "thính"
Sau vòng For 1 có B7 = "chính"
Sau vòng For 1 có B7 = "chích"

Kết quả cuối cùng là B7 = "chích"?

Và code sẽ được chạy cho sheet bất kỳ hay chỉ 1 sheet cụ thể?

Hãy mô tả kỹ và cụ thể, nếu bạn làm bằng tay thì bạn làm như thế nào. Lấy vd. cụ thể. Như thế là tốt nhất.

LEHOC · 16/9/19

batman1 đã viết:
Thực ra tôi không hứng. Nhưng nếu muốn người khác viết hộ code thì cũng nên đính kèm tập tin. Chả nhẽ viết chay không test? Con người nhiều khi phạm những lỗi rất đơn giản, vd. viết nhầm, viết thừa dấu chấm dấu phẩy. Không có tập tin thì test thế nào?
-----
Mà tốt nhất là mô tả kỹ bạn cần làm gì. Chưa chắc code của bạn làm đúng yêu cầu.

Tôi cho ví dụ. Giả sử trong sheet hiện hành chỉ có ô B7 <> rỗng và B7 = "anh". Giả sử sheet3 chỉ có dữ liệu K2 = "a", K3 = "th", K4 = "n", L2 = "thí", L3 = "ch", L4 = "c"

Sau vòng For 1 có B7 = "thính"
Sau vòng For 1 có B7 = "chính"
Sau vòng For 1 có B7 = "chích"

Kết quả cuối cùng là B7 = "chích"?

Và code sẽ được chạy cho sheet bất kỳ hay chỉ 1 sheet cụ thể?

Hãy mô tả kỹ và cụ thể, nếu bạn làm bằng tay thì bạn làm như thế nào. Lấy vd. cụ thể. Như thế là tốt nhất.

Em gửi anh File cụ thể.
Code này em chỉ làm cho trường hợp cụ thể anh ơi.
Cảm ơn anh!

batman1 · 16/9/19

LEHOC đã viết:
Em gửi anh File cụ thể.
Code này em chỉ làm cho trường hợp cụ thể anh ơi.
Cảm ơn anh!

Bạn có bao nhiêu dòng dữ liệu mà kêu code chạy lâu?

Nếu thực hiện các bước hoán đổi y hệt như bạn thì thử code sau.

Mã:

Sub test()
Dim data(), Arr(), k As Long, r As Long
    With Sheet2
        k = .Cells(Rows.Count, "A").End(xlUp).Row
        If k < 2 Then Exit Sub
        Arr = .Range("A2:B" & k).Value
    End With
    With Sheet1
        k = .Cells(Rows.Count, "B").End(xlUp).Row
        If k < 7 Then Exit Sub
        data = .Range("B7:B" & k + 1).Value
    End With
    For r = 1 To UBound(data) - 1
        For k = 1 To UBound(Arr)
            data(r, 1) = Replace(data(r, 1), Arr(k, 1), Arr(k, 2), , , vbTextCompare)
        Next k
    Next r
    
    Sheet1.Range("B7").Resize(UBound(data)).Value = data
End Sub

LEHOC · 17/9/19

batman1 đã viết:

Bạn có bao nhiêu dòng dữ liệu mà kêu code chạy lâu?

Nếu thực hiện các bước hoán đổi y hệt như bạn thì thử code sau.

Mã:

Sub test()
Dim data(), Arr(), k As Long, r As Long
    With Sheet2
        k = .Cells(Rows.Count, "A").End(xlUp).Row
        If k < 2 Then Exit Sub
        Arr = .Range("A2:B" & k).Value
    End With
    With Sheet1
        k = .Cells(Rows.Count, "B").End(xlUp).Row
        If k < 7 Then Exit Sub
        data = .Range("B7:B" & k + 1).Value
    End With
    For r = 1 To UBound(data) - 1
        For k = 1 To UBound(Arr)
            data(r, 1) = Replace(data(r, 1), Arr(k, 1), Arr(k, 2), , , vbTextCompare)
        Next k
    Next r
   
    Sheet1.Range("B7").Resize(UBound(data)).Value = data
End Sub

Cảm ơn bác!

LEHOC · 18/9/19

batman1 đã viết:
Bạn có bao nhiêu dòng dữ liệu mà kêu code chạy lâu?

Em có 80 dòng data và 25 dong Replace, nhưng có thời điểm nó chạy bị lỗi sao ấy, nó treo thời gian phải tới 30s.
Nhưng giờ lại trở lại tầm vài ba giây thôi.
Cảm ơn anh!

Tối ưu Replace trong VBA

LEHOC

Thành viên chính thức

leonguyenz

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

VetMini

Ăn cùng góc phố

batman1

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

LEHOC

Thành viên chính thức

batman1

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

LEHOC

Thành viên chính thức

File đính kèm

batman1

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

LEHOC

Thành viên chính thức

LEHOC

Thành viên chính thức

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng