Nhờ các bác sửa hộ code: Thay thế trong Excel, để chạy nhanh hơn. Em xin cảm ơn! (2 người xem)

trungtamcnc · 5/11/22

Em có 1 file được sử dụng trong việc đổi mã phách. Em đã viết được code nhưng chạy quá chậm do dùng nhiều vòng lặp. Nhờ các bác giúp về code cho công việc nhanh hơn. Em cảm ơn nhiều.

Mã:

Sub doiphachmoi()
Dim str1 As String
Dim str2 As String
Dim Tmr As Double

str1 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach can thay")
str2 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach moi")
Tmr = Timer()
Lr1 = Cells(Rows.Count, 10).End(xlUp).Row

For i = 2 To Lr1
    For ii = 1 To 12
    For iii = 1 To 20
    Cells(i, 5).Replace What:=ii & str1 & iii, Replacement:=ii & str2 & iii, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells(i, 10).Replace What:=ii & str1 & iii, Replacement:=ii & str2 & iii, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Next iii
    Next ii
Next i
    Range("I2:I13").ClearContents
    Range("F2:F" & Lr1).ClearContents
    Range("K2:K" & Lr1).ClearContents
MsgBox Timer() - Tmr
End Sub

donghung1512 · 5/11/22

trungtamcnc đã viết:

Em có 1 file được sử dụng trong việc đổi mã phách. Em đã viết được code nhưng chạy quá chậm do dùng nhiều vòng lặp. Nhờ các bác giúp về code cho công việc nhanh hơn. Em cảm ơn nhiều.

Mã:

Sub doiphachmoi()
Dim str1 As String
Dim str2 As String
Dim Tmr As Double

str1 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach can thay")
str2 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach moi")
Tmr = Timer()
Lr1 = Cells(Rows.Count, 10).End(xlUp).Row

For i = 2 To Lr1
    For ii = 1 To 12
    For iii = 1 To 20
    Cells(i, 5).Replace What:=ii & str1 & iii, Replacement:=ii & str2 & iii, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells(i, 10).Replace What:=ii & str1 & iii, Replacement:=ii & str2 & iii, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Next iii
    Next ii
Next i
    Range("I2:I13").ClearContents
    Range("F2:F" & Lr1).ClearContents
    Range("K2:K" & Lr1).ClearContents
MsgBox Timer() - Tmr
End Sub

Bạn thêm câu lệnh này vào đầu
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

và câu lệnh vào cuối code
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

giaiphap · 5/11/22

trungtamcnc đã viết:

Em có 1 file được sử dụng trong việc đổi mã phách. Em đã viết được code nhưng chạy quá chậm do dùng nhiều vòng lặp. Nhờ các bác giúp về code cho công việc nhanh hơn. Em cảm ơn nhiều.

Mã:

Sub doiphachmoi()
Dim str1 As String
Dim str2 As String
Dim Tmr As Double

str1 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach can thay")
str2 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach moi")
Tmr = Timer()
Lr1 = Cells(Rows.Count, 10).End(xlUp).Row

For i = 2 To Lr1
    For ii = 1 To 12
    For iii = 1 To 20
    Cells(i, 5).Replace What:=ii & str1 & iii, Replacement:=ii & str2 & iii, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells(i, 10).Replace What:=ii & str1 & iii, Replacement:=ii & str2 & iii, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Next iii
    Next ii
Next i
    Range("I2:I13").ClearContents
    Range("F2:F" & Lr1).ClearContents
    Range("K2:K" & Lr1).ClearContents
MsgBox Timer() - Tmr
End Sub

Thử với code này.

Mã:

Sub doiphachmoi()
Dim str1 As String
Dim str2 As String
Dim Tmr As Double
Dim dArr, sArr

str1 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach can thay")
str2 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach moi")
Tmr = Timer()
With Sheet1
    lr1 = .Cells(Rows.Count, 10).End(xlUp).Row
    dArr = .Range("E2:E" & lr1).Value2
    sArr = .Range("J2:J" & lr1).Value2
    For i = 1 To UBound(dArr, 1)
        dArr(i, 1) = Replace(dArr(i, 1), str1, str2)
        sArr(i, 1) = Replace(sArr(i, 1), str1, str2)
    Next
    .Range("E2:E" & lr1).Resize(UBound(dArr, 1)).Value = dArr
    .Range("J2:J" & lr1).Resize(UBound(sArr, 1)).Value = sArr
    .Range("I2:I13").ClearContents
    .Range("F2:F" & lr1).ClearContents
    .Range("K2:K" & lr1).ClearContents
End With
MsgBox Timer() - Tmr
End Sub

trungtamcnc · 5/11/22

giaiphap đã viết:

Thử với code này.

Mã:

Sub doiphachmoi()
Dim str1 As String
Dim str2 As String
Dim Tmr As Double
Dim dArr, sArr

str1 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach can thay")
str2 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach moi")
Tmr = Timer()
With Sheet1
    lr1 = .Cells(Rows.Count, 10).End(xlUp).Row
    dArr = .Range("E2:E" & lr1).Value2
    sArr = .Range("J2:J" & lr1).Value2
    For i = 1 To UBound(dArr, 1)
        dArr(i, 1) = Replace(dArr(i, 1), str1, str2)
        sArr(i, 1) = Replace(sArr(i, 1), str1, str2)
    Next
    .Range("E2:E" & lr1).Resize(UBound(dArr, 1)).Value = dArr
    .Range("J2:J" & lr1).Resize(UBound(sArr, 1)).Value = sArr
    .Range("I2:I13").ClearContents
    .Range("F2:F" & lr1).ClearContents
    .Range("K2:K" & lr1).ClearContents
End With
MsgBox Timer() - Tmr
End Sub

Cảm ơn bác. Đã hạ thời gian từ 7s xuống 0,03s.

HUONGHCKT · 5/11/22

trungtamcnc đã viết:
Em có 1 file được sử dụng trong việc đổi mã phách. Em đã viết được code nhưng chạy quá chậm do dùng nhiều vòng lặp. Nhờ các bác giúp về code cho công việc nhanh hơn. Em cảm ơn nhiều.

Dùng tạm file này trong khi chờ các giải pháp khác. Trúng trật - hên sui.
Đăng rồi mới thấy bài của anh @giaiphap. Định xóa, nhưng lại thôi

trungtamcnc · 5/11/22

HUONGHCKT đã viết:
Dùng tạm file này trong khi chờ các giải pháp khác. Trúng trật - hên sui.
Đăng rồi mới thấy bài của anh @giaiphap. Định xóa, nhưng lại thôi

Cảm ơn bác. Bác còn viết thêm code tình huống nữa. Rất hay ạ. Nhưng code của bác xóa hết những vị trí đánh dấu v ở cột E.

Mã:

   str2 = InputBox("Nhap cac ki tu (VD: K, L, M, N)", "Ma phach moi")
    If str1 <> str2 Then
        GoTo Chay1
    Else
        MsgBox "CHUA NHÂP MA PHÁCH MOI": Exit Sub
    End If

HUONGHCKT · 5/11/22

trungtamcnc đã viết:
Cảm ơn bác. Bác còn viết thêm code tình huống nữa. Rất hay ạ. Nhưng code của bác xóa hết những vị trí đánh dấu v ở cột E.

Thế vv ấy không phải là vân vân và vân vân à.
Bạn có thể thử thay thế mảng Res1, Res ấy bằng chính mảng Arr1, Arr, chỉ khác là nếu tìm thấy ký tự Str1, thì Arr(i,1)=Arr(t,1)
ví dụ

Mã:

 For i = 1 to ubound( Arr) 
t=t +1 
if Arr(i,1) like "*" & str1 & "*" 
Arr(t,1)=Replace(Arr(i,1),srt1,str2)  ' cái đoạn tìm kiếm và thay thế rất hay của anh @giaiphap 
else
Arr(t,1)=Arr(i,1)
end if

VetMini · 5/11/22

Chạy code xong ít nhất phải bỏ ra 1 phút để kiểm tra kết quả có gì trục trặc. 7 giây mà cũng muốn tiết kiệm.

Tôi thì đặt trọng tâm công việc vào chỗ khác cho chu đáo.

Nhờ các bác sửa hộ code: Thay thế trong Excel, để chạy nhanh hơn. Em xin cảm ơn! (2 người xem)

Người dùng đang xem chủ đề này

trungtamcnc

Thành viên hoạt động

File đính kèm

donghung1512

Thành viên hoạt động

giaiphap

==(^o^)==

trungtamcnc

Thành viên hoạt động

HUONGHCKT

Zalo 0986997214

File đính kèm

trungtamcnc

Thành viên hoạt động

HUONGHCKT

Zalo 0986997214

VetMini

Ăn cùng góc phố

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

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

Đếm ngược thời gian