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

Liên hệ QC
trungtamcnc

trungtamcnc

Thành viên hoạt động
Tham gia
5/4/10
Bài viết
124
Được thích
9
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
 

File đính kèm

  • CODE SBD va MaPHACH.xlsb
    25.2 KB · Đọc: 10
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
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác. Đã hạ thời gian từ 7s xuống 0,03s.
 
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.
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • CODE SBD va MaPHACH.xlsb
    26.9 KB · Đọc: 7
Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộng...
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
 
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.
Nhấp chuột vào đây để mở rộng...
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
 
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.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Salem999999999
Lọc dữ liệu có điều kiện
2
Trả lời
25
Đọc
525
tle2003
T
vuongnlks
Lấy dữ liệu 1 cột cụ thể theo ngày từ nhiều file CSV ứng với mã tương ứng trong cột MA CO PHIEU
Trả lời
1
Đọc
69
BuiQuangThuan
B
V
Hỗ trợ hàm Sumproduct và Subtotal trong GG Sheets
Trả lời
3
Đọc
225
nguyenngocphuongsw
nguyenngocphuongsw
son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
10
Đọc
205
tle2003
T
K
Tính tổng có điều kiện
Trả lời
4
Đọc
156
kimson_nb
K
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom