Giúp code đổi tên theo điều kiện

[Văn Toàn 1996]

Chào tất cả mọi người . Mình cần 1 đoạn code đổi 1 tên trong 1 vùng như ảnh mô tả bên dưới
Tên mặt hàng có 2 kiểu , Kiểu 1 là Tên gốc ( Ví dụ: Cam ) , Kiểu 2 thì mình nối thêm -1,-2... ( Ví dụ: Cam-1, Cam-2 ) mình muốn đổi tên mặt hàng là Cam sang Ngô thì chỉ áp dụng cho các tên ký tự bên tay Trái là Cam Hoặc tên có nối Cam-1, Cam-2...Các tên mặt hàng không thỏa mãn điều kiện trên thì vẫn giử nguyên , Và code không phân biệt chữ Hoa và Chữ Thường. Xin chân thành cảm ơn

 

[bebo021999]

Dùng tạm trong khi chờ phương án khác:

Option Explicit
Sub doiten()
Dim lr&, i&, rng, res(), oldV As String, newV As String
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("B3:B" & lr).Value
ReDim res(1 To UBound(rng), 1 To 1)
oldV = Range("D3").Value: newV = Range("E3").Value
For i = 1 To UBound(rng)
    If Len(rng(i, 1)) = Len(oldV) Or rng(i, 1) & "-" Like oldV & "-*" Then
        res(i, 1) = Replace(rng(i, 1), oldV, newV)
    Else
        res(i, 1) = rng(i, 1)
    End If
Next
Range("G3:G10000").ClearContents
Range("G3").Resize(UBound(res), 1).Value = res
End Sub

 

[Văn Toàn 1996]

Dùng tạm trong khi chờ phương án khác:

Option Explicit
Sub doiten()
Dim lr&, i&, rng, res(), oldV As String, newV As String
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("B3:B" & lr).Value
ReDim res(1 To UBound(rng), 1 To 1)
oldV = Range("D3").Value: newV = Range("E3").Value
For i = 1 To UBound(rng)
    If Len(rng(i, 1)) = Len(oldV) Or rng(i, 1) & "-" Like oldV & "-*" Then
        res(i, 1) = Replace(rng(i, 1), oldV, newV)
    Else
        res(i, 1) = rng(i, 1)
    End If
Next
Range("G3:G10000").ClearContents
Range("G3").Resize(UBound(res), 1).Value = res
End Sub

Cảm ơn bạn. Code chạy đúng thuật Toán mình mong muốn, Nhưng mình không muốn phân biệt chữ Hoa và chữ Thường , tức là ( CAM,cam, Cam, CAm ) đều được. Nhờ bạn sửa lại giúp

 

[bebo021999]

Cảm ơn bạn. Code chạy đúng thuật Toán mình mong muốn, Nhưng mình không muốn phân biệt chữ Hoa và chữ Thường , tức là ( CAM,cam, Cam, CAm ) đều được. Nhờ bạn sửa lại giúp

Thử lại nhé....

Option Explicit
Sub doiten()
Dim lr&, i&, rng, res(), oldV As String, newV As String
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("B3:B" & lr).Value
ReDim res(1 To UBound(rng), 1 To 1)
oldV = UCase(Range("D3").Value): newV = Range("E3").Value
For i = 1 To UBound(rng)
    If UCase(rng(i, 1)) = oldV Or _
    (UCase(rng(i, 1)) & "-" Like oldV & "-*" And IsNumeric(Mid(rng(i, 1), Len(oldV) + 2, 1))) Then
        res(i, 1) = newV & Mid(rng(i, 1), Len(oldV) + 1, 255)
    Else
        res(i, 1) = rng(i, 1)
    End If
Next
Range("G3:G10000").ClearContents
Range("G3").Resize(UBound(res), 1).Value = res
End Sub

 

[VetMini]

Function DoiTenTraiCay(rg As Range, tcu As String, tmoi As String)
' returns the name of produce in rg, with tcu replaced by tmoi
' rules/conditons:
' tcu is at the left most place in string, eg. "Cam..."
' tcu may or may not be followed by a hyphen plus a number., eg. "Cam-1..."
Static rx As Object
' Set rx = Nothing ' sử dụng dòng này lúc debug, sau đó comment nó đi
If rx Is Nothing Then
Set rx = CreateObject("VBScript.RegExp")
rx.Global = True
rx.IgnoreCase = True
rx.Pattern = Replace("^(<TC>)(-[0-9]+)?$", "<TC>", tcu)
End If
DoiTenTraiCay = rx.Replace(rg.Value, tmoi & "$2")
End Function

Ô G3, gõ:,
=DoiTenTraiCay($B3, $D$3, $E$3)
Kéo xuống đến hết

Đính chính: code trước đây không có đánh dấu cuối chuỗi cho nên dòng "Cam Cam" sẽ ra sai. Đã chỉnh lại, thêm $ vào cuối pattern.

 

[Phuocam]

Code chưa bẫy lỗi:

Public Function ThayDoiTen(ByVal s As String, ByVal tenCu As String, ByVal tenMoi As String) As String
tenCu = UCase(tenCu)
ThayDoiTen = s
If UCase(Split(s & "-", "-")(0)) = tenCu Then ThayDoiTen = tenMoi & VBA.Mid(s, Len(tenCu) + 1)
End Function

 

[Văn Toàn 1996]

Thử lại nhé....

Option Explicit
Sub doiten()
Dim lr&, i&, rng, res(), oldV As String, newV As String
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("B3:B" & lr).Value
ReDim res(1 To UBound(rng), 1 To 1)
oldV = UCase(Range("D3").Value): newV = Range("E3").Value
For i = 1 To UBound(rng)
    If UCase(rng(i, 1)) = oldV Or _
    (UCase(rng(i, 1)) & "-" Like oldV & "-*" And IsNumeric(Mid(rng(i, 1), Len(oldV) + 2, 1))) Then
        res(i, 1) = newV & Mid(rng(i, 1), Len(oldV) + 1, 255)
    Else
        res(i, 1) = rng(i, 1)
    End If
Next
Range("G3:G10000").ClearContents
Range("G3").Resize(UBound(res), 1).Value = res
End Sub

cảm ơn anh. Code đúng ý em rồi. em test rât kỹ không sai 1 trường hợp nào cả

 

[tranvansau278]

Ngoài dùng các code trên, bạn xài công thức này xem:
=IFERROR(IF(AND(FIND($D$3;B3)=1;LEFT(B3;4)="-");REPLACE(B3;1;3;"Ngô");B3);B3)