198108
Sub Sample1() Application.ScreenUpdating = False Dim MaxRow As Long, MaxRow3 As Long, myRange As Range, myObj As Range, keyWord As String, a As Long MaxRow = Worksheets("Sheet1").Range("A2400").End(xlUp).Row MaxRow3 = Worksheets("Sheet3").Range("A2400").End(xlUp).Row For s = 1 To MaxRow keyWord = Worksheets("Sheet1").Cells(s, 1).Value Set myRange = Range(Worksheets("Sheet3").Cells(1, 1), Worksheets("Sheet3").Cells(MaxRow3, 1)) Set myObj = myRange.Find(keyWord, LookAt:=xlWhole) If myObj Is Nothing Then Worksheets("Sheet1").Cells(s, 3).Value = Application.GetPhonetic(Worksheets("Sheet1").Cells(s, 1).Value) Else a = myObj.Row Worksheets("Sheet1").Cells(s, 3).Value = Worksheets("Sheet3").Cells(a, 2) End If Next Worksheets("Sheet1").Activate Worksheets("Sheet1").Range(Cells(1, 1), Cells(MaxRow, 24)).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlNo Application.ScreenUpdating = True End Sub Sub SheetClear() Sheets("Sheet1").Cells.Clear Worksheets("Sheet1").Activate End Sub
