Bạn thay thế code mới dưới đây xem sao.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sArr(), dArr(), tArr(), i As Long, j As Long, N As Long, L As Long, T
tArr = Sheets("GPE").Range("A2", Sheets("GPE").Range("A2").End(xlDown)).Resize(, 2).Value
With Sheets("ngoai")
sArr = .Range("A2", .Range("A2").End(xlDown)).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
For Each T In Split(sArr(i, 1))
For j = 1 To UBound(tArr)
If InStr(" " & T & " ", " " & tArr(j, 1) & " ") Then
dArr(i, 1) = dArr(i, 1) & " " & tArr(j, 2)
Exit For
Else
End If
Next j
Next T
dArr(i, 1) = Trim(dArr(i, 1))
If dArr(i, 1) = "" Then dArr(i, 1) = sArr(i, 1)
'For j = 1 To UBound(tArr)
' N = InStr(sArr(i, 1), tArr(j, 1))
' If N Then
' L = Len(tArr(j, 1))
' dArr(i, 1) = Left(sArr(i, 1), N - 1) & tArr(j, 2) & Mid(sArr(i, 1), N + L, Len(sArr(i, 1)))
' Exit For
' End If
' If N = 0 Then dArr(i, 1) = sArr(i, 1)
' Next j
Next i
.Range("B2").Resize(i - 1) = dArr
End With
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A2:A999]) Is Nothing Then
Const KT As String = " ": Dim TuTra As String
Dim VTr As Byte: Dim WF As Object
Set WF = Application.WorksheetFunction
VTr = InStr(Trim$(Target.Value), KT)
If VTr Then
TuTra = Trim$(Left$(Target.Value, VTr))
Target.Offset(, 1).Value = _
Replace(Target.Value, TuTra, WF.VLookup(TuTra, Sheets("GPE").[A2:B9], 2, False))
Else
TuTra = WF.VLookup(Target.Value, Sheets("GPE").[A2:B9], 2, False)
End If
End If
End Subphương pháp này có chậm hơn so với 2 phương pháp trên không ạ.
phương pháp này thiếu phần kiểm tra cột A sheet (ngoai) không giống với cột A sheet(GPE) thì cột B sheet(ngoai) = cột A sheet (ngoai)
em đã thử và đúng như em mong muốn, nhưng khi kết hợp cụm dữ liệu không có thì chưa chính xác. mong anh giúp em thêm lần nữa ạ. ví dụ "nguyễn văn ban" kết quả chính xác sẽ cho là "nguyễn văn năm" chứ không phải cho mỗi kết quả là "năm"
Bạn chạy code đây. Code so sánh từng từ, khớp thì thay, không thì giữ như cũ
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sArr(), dArr(), tArr(), i As Long, j As Long, N As Long, L As Long, T
tArr = Sheets("GPE").Range("A2", Sheets("GPE").Range("A2").End(xlDown)).Resize(, 2).Value
With Sheets("ngoai")
sArr = .Range("A2", .Range("A2").End(xlDown)).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
For Each T In Split(sArr(i, 1))
N = 0
For j = 1 To UBound(tArr)
If InStr(" " & T & " ", " " & tArr(j, 1) & " ") Then
dArr(i, 1) = dArr(i, 1) & " " & tArr(j, 2)
N = 1
Exit For
End If
Next j
If N = 0 Then dArr(i, 1) = dArr(i, 1) & " " & T
Next T
dArr(i, 1) = Trim(dArr(i, 1))
Next i
.Range("B2").Resize(i - 1) = dArr
End With
End Subcám ơn anh đã giúp, đúng như em mong muốn
Anh ơi chỉnh sửa lại giúp em file hôm trước. vì khi dữ liệu cần tìm ở cột A mà nhiều hàng. thì mỗi lúc thay đổi bất kỳ ô nào trên cột A thời gian chuyển đổi sẽ bị chậm. giờ em muốn chỉ khi nào thay đổi bất kỳ ô nào ở cột A (ngoai) thì mới cần chuyển. chứ không cần vòng lặp nữa. em xin cảm ơn
Anh ơi chỉnh sửa lại giúp em file hôm trước. vì khi dữ liệu cần tìm ở cột A mà nhiều hàng. thì mỗi lúc thay đổi bất kỳ ô nào trên cột A thời gian chuyển đổi sẽ bị chậm. giờ em muốn chỉ khi nào thay đổi bất kỳ ô nào ở cột A (ngoai) thì mới cần chuyển. chứ không cần vòng lặp nữa. em xin cảm ơn
Có 2 file kèm (attached) thì lấy file nào?
2 file là một. lúc đính kèm bị ra ngoài. Tất nhiên viết để ứng dụng. chứ viết cho vui thì nhọc công làm gì ạ. Em định viết để ứng dụng dịch thuật thôi. VD: sẽ có sheet(GPE) (chứa nội dung dữ liệu để so sánh) còn một sheet (ngoai) ( để nhập vào A2, thì B2 sẽ tự chuyển tương ứng). Ở file trên đã chuyển đúng mục đính. tuy nhiên có vấn đề là dùng vòng lặp ở cột A trong sheet(ngoai) khi đó chương trình sẽ chạy không tối ưu. mỗi lần nhập ô bất kỳ ở cột A thì lại chạy hết dữ liệu trong cột A sheet(ngoai)
Vậy thay sub đó bằng cái này cho nhanh
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Cells.Count = 1 Then
Application.EnableEvents = False
On Error GoTo 1
Dim tArr(), sT As String, k As Long
tArr = Sheets("GPE").Range("A2", Sheets("GPE").Range("A2").End(xlDown)).Resize(, 2).Value
sT = " " & Replace(Target.Value, " ", " ") & " "
For k = 1 To UBound(tArr)
sT = Replace(sT, " " & tArr(k, 1) & " ", " " & tArr(k, 2) & " ")
Next k
Target.Offset(, 1).Value = WorksheetFunction.Trim(sT)
1: Application.EnableEvents = True
End If
End SubCám ơn anh và mọi người đã giúp. em sẽ dùng sub cũ làm nút cập nhật dữ liệu. khi dữ liệu gốc thay đổi. còn sub này dùng luôn khi nhập.
