PDA

View Full Version : Compare and replace- English and French Translation- Optimization.



kitwit
07-28-2018, 06:49 PM
Hi,

Is there a way i can optimize this code below, when i run it on large set of values, it just freezes; this is compare and replace script from a dictionary list.



Option Explicit
Sub TranslateEngFr2()
Dim rEngFr As Range, rEng As Range, r As Range, r2, InputRng As Range
Dim iEng As Long
Dim MyAdd$, xTitleId$

Set InputRng = Application.Selection
Set rEng = Application.InputBox("Convert Which text :", xTitleId, Type:=8)
Set rEngFr = Application.InputBox("translation dictionary ", xTitleId, InputRng.Address, Type:=8)


Application.ScreenUpdating = False

For Each r In rEng.Cells
For Each r2 In rEngFr.Rows
If r.Value = r2.Cells(1, 1).Value Then
r.Value = r2.Cells(1, 2).Value
r.Interior.Color = vbGreen
Exit For
End If
Next
Next

Application.ScreenUpdating = True


End Sub

Paul_Hossler
07-29-2018, 06:22 AM
Starting point



Option Explicit


Sub TranslateEngFr2()
Dim rEngFr As Range, rEng As Range, r As Range, r2, InputRng As Range
Dim iEng As Long
Dim MyAdd As String, xTitleId As String
Dim oDic As Object

Application.ScreenUpdating = False

Set oDic = CreateObject("Scripting.Dictionary")
oDic.CompareMode = vbTextCompare

Set InputRng = Application.Selection

'commented out for testing
' Set rEng = Application.InputBox("Convert Which text :", xTitleId, Type:=8)
' Set rEngFr = Application.InputBox("translation dictionary ", xTitleId, InputRng.Address, Type:=8)

'added for testing
Set rEng = ActiveSheet.Cells(1, 1).CurrentRegion
Set rEngFr = ActiveSheet.Cells(1, 3).CurrentRegion

For Each r In rEngFr.Rows
On Error Resume Next
'Eng is the key, Fr is the data
oDic.Add r.Cells(1, 1).Value, r.Cells(1, 2).Value
On Error GoTo 0
Next

For Each r In rEng.Cells
If oDic.exists(r.Value) Then
r.Value = oDic(r.Value)
r.Interior.Color = vbGreen
End If
Next

Application.ScreenUpdating = True
End Sub

stefanoste78
07-30-2018, 03:26 AM
Sorry. Does the attached macro do the translation or something else? I do not seem to see words or a translation when I launch the macro :)

Paul_Hossler
07-30-2018, 06:33 AM
You didn't provide any test materials so I made my own.

This was a only starting point to show one (of many) techniques -- I used a scripting dictionary approach.

I also saved some of my time for testing and demo by 'locking' the ranges, so remove the appropriate comment lines


In Before.jpg the blue in col A are the 'English' text to be translated, the blue in col C is the 'From English' word and the red in col D is the 'To French' word

In After.jpg, the green in col A are the original English words matched in col C replaced by the corresponding French words in col D


If you're looking for something different, then a sample workbook and more details will be helpful


22646 22647

seshu
07-31-2018, 04:08 AM
Hi This is Seshu, i am new to this form.

I need help to Replace values in excel sheet, in a particular column.

please see below my requirement.



column name1


if column name1 = "ALL" or "PATI",
then column name1="No",
else column name1="Yes"