Page 1 of 1

Find & Replace Sample of multiple operations.

Posted: Thu Feb 07, 2008 6:52 pm
by JohnV
At the request of lapsedLibrarian I have created a macro to do multiple find & replace operation at one time. It is heavily commented and meant to provide you with a way to customize it for your own needs.

Please note the USER VARIABLE "AskMe" near the beginning of the file which controls whether you are asked about doing each of the operations.

Also note that my definition of the AskArray extends over several lines by using "_" to continue the definition to the next line. "_" must be the last character on the line and if is followed inadvertently by a space you will get an error.

Code: Select all

Option Explicit 'You must Dim all variables.
Sub CleanUp
Dim AskMe as Boolean
'>>>>>>>>>>>>USER VARARBLE<<<<<<<<<<<
AskMe = True  'Change to False to avoid the query for each find & replace.
'>>>>>>>>>>END USER VARIABLE<<<<
Dim oDoc,AskArray,SearchArray,ReplaceAray,FandR,c,iAns
'Array contents:
AskArray = Array("Replace multiple spaces with one space?",_
"Delete spaces before paragraph breaks?",_
"Delete spaces before tabs?",_
"Delete spaces after tabs?")
REM Place in quotes what you would put in the Search/Replace boxes
REM in the Find & Replace dialog without the quotes. 
SearchArray = Array(" *"," *$"," *\t","\t *")
ReplaceAray = Array(" " ,""   ,"\t"  ,"\t"  ) 
oDoc = ThisComponent 'Get the current active document.
FandR = oDoc.createReplaceDescriptor 'Set up find & replace.
FandR.searchRegularExpression = True 'Make it recognise regular expressions.
For c = 0 to uBound(SearchArray) 'Loop through the arrays.
If AskMe then 'If AskMe is True then ask.
  iAns = MsgBox (AskArray(c),3)'See Help in the Basic IDE for the various
  'buttons available in MsgBox and the integers they return.   
If iAns = 2 then End 'Cancel button clicked so quit.
EndIf
IF iAns = 6 or AskMe = False then 'Yes button clicked, or assumed clicked,
  'so do the find & replace.
  FandR.setSearchString(SearchArray(c))
  FandR.setReplaceString(ReplaceAray(c))
  oDoc.ReplaceAll(FandR)
EndIf
'The No button will simple fall through to here so there is no need to process it.
Next c
End Sub

Re: Find & Replace Sample of multiple operations.

Posted: Fri May 09, 2008 7:52 pm
by Bhikkhu Pesala
I am still using several versions of the Find and Replace macro that you wrote for me to update documents encoded without out-of-date custom font encodings. It is very easy to edit for different tasks. I stripped all of the comments as I think it is fairly obvious what to edit in the two arrays. The speed of this macro is simply amazing, even on long documents.

Code: Select all

Sub SktToUnicode
oDoc = thisComponent 
aFind = Array("  ", "Æ","æ" ,"Ø", "ø" ,"Þ" ,"þ", "Ð", "ð", "Ḥ", "ḥ", "¡", "¹", "º", "µ", "¤", "¼", "£", "³", "®", "¶", "¾", "½", "±", "ª", "©", "¢", "¿", "¥") 
aReplace = Array(" ", "Ā", "ā", "Ī", "ī", "Ū", "ū", "Ḍ", "ḍ", "²", "¬", "Ḷ", "ḷ", "Ṃ", "ṃ", "Ṇ", "ṇ", "Ṅ", "ṅ", "Ṛ", "ṛ", "Ṝ", "ṝ", "Ṣ", "ṣ", "Ś", "ś", "Ṭ", "ṭ") 
aRayCount = 0 
FandR = oDoc.createReplaceDescriptor 
FandR.SearchCaseSensitive = true
FandR.SearchRegularExpression = true 
While aRayCount <= uBound(aFind) 
 FandR.setSearchString(aFind(aRayCount)) 
 FandR.setReplaceString(aReplace(aRayCount)) 
 aRayCount = aRayCount + 1 
 oDoc.ReplaceAll(FandR) 
Wend 
End Sub

Re: Find & Replace Sample of multiple operations.

Posted: Wed Feb 10, 2010 4:47 am
by sorcha
I'm just posting to say I found this really helpful. I wanted to convert Latin text to Hebrew characters, but I use an idiosyncratic keyboard layout for Hebrew text entry, so there's nothing readily available to do the job.

I've never written a macro before, but I used the examples as a guide and eventually I got it to work!

This is what I came up with:

Code: Select all

Sub LatinToHebrew
REM 'final mem does not get converted because it is entered with "." which causes chaos
Dim oDoc,aFind,aReplace,aRayCount,FandR
oDoc = thisComponent
aFind = Array("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z","B","C","D","E","F","G","H","J","L","M","N","P","Q","R","S","T","V","W","X","Y","Z","0","1","2","3","4","5","6","7","8","9","-","=","`","¬",";","'","@",",")
aReplace = Array("א","ב","כ","ד","שׁ","פ","ג","ה","ע","ט","ח","ל","מ","נ","וֺ","ף","ק","ר","ס","ת","וּ","ו","ש","צ","י","ז","בּ","כּ","דּ","שּ","פּ","גּ","הּ","טּ","לּ","מּ","נּ","ףּ","קּ","רּ","סּ","תּ","וּ","שּ","צּ","יּ","זּ","ֲ","ָ","ַ","ֵ","ֶ","ְ","ִ","ֹ","ֻ","ֳ","ֱ","־","שׂ","שּׂ","ץ","ך","ךּ","ן")
aRayCount = 0
FandR = oDoc.createReplaceDescriptor
FandR.SearchCaseSensitive = true
FandR.SearchRegularExpression = true
While aRayCount <= uBound(aFind)
FandR.setSearchString(aFind(aRayCount))
FandR.setReplaceString(aReplace(aRayCount))
aRayCount = aRayCount + 1
oDoc.ReplaceAll(FandR)
Wend
End Sub
It may not look like much to experienced macro-writers, but I'm quite excited about it!
Thanks,
Sorcha

Re: Find & Replace Sample of multiple operations.

Posted: Sat Nov 05, 2011 12:35 am
by Junesun
Thank you! This saved me as I was writing a macro to automatically give me the pronunciation of a vowellized Arabic text in Latin romanization. Here's my code, a variation on the above:

Code: Select all

Sub Transliterate
	oDoc = thisComponent 
	aFind = Array("أَ", "أُ", "إ", "إِ", "أ", "ا" ,"ب", "ع", "ء", "د", "ض", "ف", "ذ", "غ", "ه", "ح", "ج", "ك", "ل", "م", "ن", "ق", "ر", "س", "ص", "ت", "ط", "ش", "ث", "و", "خ", "ي", "ز", "ظ", "،", "؛", ":", "ى", "آ", "ة", _
"ـَ", "ـِ", "ـُ", "ّ", "ـْ", "ً", "ٍ", "ٌ", "َـ", "ْ", "ُ", "َ", "؟")
	aReplace = Array("'a", "'u", "'i", "'i", "'", "aa", "b", "´", "'", "d", "D", "f", "dh", "gh", "h", "H", "j", "k", "l", "m", _
"n", "q", "r", "s", "S", "t", "T", "sh", "th", "w", "kh", "y", "z", "DH", ",", ";", ":", "a", "'aa", "a", _
"a", "i", "u", "2", "", "an", "in", "un", "", "a", "u", "a", "?")
	aRayCount = 0 
	FandR = oDoc.createReplaceDescriptor 
	FandR.SearchCaseSensitive = false
	FandR.SearchRegularExpression = true 
	While aRayCount <= uBound(aFind) 
		FandR.setSearchString(aFind(aRayCount)) 
		FandR.setReplaceString(aReplace(aRayCount)) 
		aRayCount = aRayCount + 1 
		oDoc.ReplaceAll(FandR) 
	Wend 
	FandR.setSearchString("aaa")
	FandR.setReplaceString("aa")
	oDoc.ReplaceAll(FandR)
	FandR.setSearchString(" aal")
	FandR.setReplaceString(" al")
	oDoc.ReplaceAll(FandR)
End Sub
The biggest issue was to get Search & Replace to play nice with the short vowel diacritics, as they apparently take different shape for this.
Note: Shadda is represented as a 2 rather than the repeated letter - it's probably possible to solve that via a regular expression, but I cannot figure it out right now.

Re: Find & Replace Sample of multiple operations.

Posted: Fri Jan 06, 2012 4:12 am
by tonaveenv
how can I highlight the replaced word with any colour.

Re: Find & Replace Sample of multiple operations.

Posted: Mon Nov 12, 2012 9:45 am
by Arcadius
Hi,

Could anyone tell me please, what I am missing here ? My OO says it did not find the method "createReplaceDescriptor". What gives ?

Oh...I forgot to add that my knowledge equals=0 as far as programming is concerned. Please help - anyone ?

Re: Find & Replace Sample of multiple operations.

Posted: Mon Nov 12, 2012 10:52 am
by RoryOF
We need to see what code you are using.

Re: Find & Replace Sample of multiple operations.

Posted: Mon Nov 12, 2012 11:59 am
by Arcadius
I tried to use one of the above. For example, I tried:

Code: Select all

    Sub LatinToHebrew
    REM 'final mem does not get converted because it is entered with "." which causes chaos
    Dim oDoc,aFind,aReplace,aRayCount,FandR
    oDoc = thisComponent
    aFind = Array("1523055","1524219","1523306","1527579","158867","159080","159109","1522831","1528375","1522851","1528152","158988","1522979","1523617","158713","1522784","1523001","1523713","1528257","1528617","1523280","1522992","158874","158945","1528153","1528369","1523048","1528192","1528460","1528208","1528368","156696","159260","1523171","159309","1528384","1523058","158426","158476","1523418","1528293","1528155","2704","1522966","159076","1524218","1528618","1524055","156660","158670","158953","1522953","1523626","159216","159099","1527589","1528292","1524368","1524216","158478","1528010","154393","1524172","159034","1528189","1523011","27104","1528167","159173","1523369","1522946","1528066","159264","1528093","1524388","159149","1523845","1522861","1528141","158813","1522862","1528114","1528573","158814","1524355","1523062","158934","158980","159077","159245","1522995","1528262","1528373","1523264","1528587","1528455","1523258","1528272","1523064","1527581","158684","1528283","2741","2748","2760","156619","1523851","1528303","1528271","1523158","1522773","1528300","1528274","2715","159183","1528143","1523049","159027","159107","159144","1523013","12403","1524048","8238","1523620","1528110","152259","156643","158865","1524000","1524071","1528581","1528380","159075","1528104","1522869","1528442","1528170","2762","156733","158870","1528612","1528253","1528441","156494","1522810","1528259","1528606","15724","15622","158672","158715","159142","1522874","1523624","1528062","159068","1528392","1528450","1528109","12289","158881","159180","1523054","158547","158877","1527590","1527994","1528452","1528080","159190","1522863","1523850","1523865","1524250","1528269","1528011","2746","158525","1524184","1524380","1528000","1528065","158918","159148","1528249","154670","1523146","1528275","1528197","1527588","1522972","158474","159025""159098")
    aReplace = Array("1523055","1524219","1523306","1527579","158867","159080","159109","1522831","1528375","1522851","1528152","158988","1522979","1523617","158713","1522784","1523001","1523713","1528257","1528617","1523280","1522992","158874","158945","1528153","1528369","1523048","1528192","1528460","1528208","1528368","156696","159260","1523171","159309","1528384","1523058","158426","158476","1523418","1528293","1528155","2704","1522966","159076","1524218","1528618","1524055","156660","158670","158953","1522953","1523626","159216","159099","1527589","1528292","1524368","1524216","158478","1528010","154393","1524172","159034","1528189","1523011","27104","1528167","159173","1523369","1522946","1528066","159264","1528093","1524388","159149","1523845","1522861","1528141","158813","1522862","1528114","1528573","158814","1524355","1523062","158934","158980","159077","159245","1522995","1528262","1528373","1523264","1528587","1528455","1523258","1528272","1523064","1527581","158684","1528283","2741","2748","2760","156619","1523851","1528303","1528271","1523158","1522773","1528300","1528274","2715","159183","1528143","1523049","159027","159107","159144","1523013","12403","1524048","8238","1523620","1528110","152259","156643","158865","1524000","1524071","1528581","1528380","159075","1528104","1522869","1528442","1528170","2762","156733","158870","1528612","1528253","1528441","156494","1522810","1528259","1528606","15724","15622","158672","158715","159142","1522874","1523624","1528062","159068","1528392","1528450","1528109","12289","158881","159180","1523054","158547","158877","1527590","1527994","1528452","1528080","159190","1522863","1523850","1523865","1524250","1528269","1528011","2746","158525","1524184","1524380","1528000","1528065","158918","159148","1528249","154670","1523146","1528275","1528197","1527588","1522972","158474","159025""159098")
    aRayCount = 0
    FandR = oDoc.createReplaceDescriptor
    FandR.SearchCaseSensitive = true
    FandR.SearchRegularExpression = true
    While aRayCount <= uBound(aFind)
    FandR.setSearchString(aFind(aRayCount))
    FandR.setReplaceString(aReplace(aRayCount))
    aRayCount = aRayCount + 1
    oDoc.ReplaceAll(FandR)
    Wend
    End Sub
This is just an example and replacement values would differ. Nevertheless, the message that I get is that createReplaceDescriptor method was not found

Re: Find & Replace Sample of multiple operations.

Posted: Mon Nov 12, 2012 1:00 pm
by Robert Tucker
Are you calling the macro from an open Writer document? Have a Writer document open, click in it with your mouse, then try to run the macro.

Re: Find & Replace Sample of multiple operations.

Posted: Mon Nov 12, 2012 4:28 pm
by Arcadius
Robert Tucker wrote:Are you calling the macro from an open Writer document? Have a Writer document open, click in it with your mouse, then try to run the macro.
Hmmm...I think it might have actually worked. At least I don't get this 'not found' anymore...

Thank you very much :-)

Now, just one more, extremelly important thing:

Could anyone please tell me, how to do the same in my spreadsheet, in Calc ?? I need to either find and replace the given values or, which would be even better, just find and highlight the found lines/records (to copy it).

I am quite desperate. I have searched the internet the best to my ability and didn't find anything quite this helpful (including this forum).

Re: Find & Replace Sample of multiple operations.

Posted: Mon Nov 12, 2012 10:27 pm
by JohnV
Could anyone please tell me, how to do the same in my spreadsheet, in Calc ??
Here's some modified code that will work in Calc.

Code: Select all

Sub CalcFindAndReplace 
Dim oDoc,aFind,aReplace,aRayCount,FandR,oSheet
oDoc = ThisComponent
aFind = Array(1,2,3)
aReplace = Array("A","B","C")
aRayCount = 0
oSheet = oDoc.getSheets.getByName(oDoc.CurrentSelection.Spreadsheet.Name)
FandR = oSheet.createReplaceDescriptor
FandR.SearchCaseSensitive = true
FandR.SearchWords = true ' 1 to A but not 11 to AA
FandR.SearchRegularExpression = true
While aRayCount <= uBound(aFind)
 FandR.setSearchString(aFind(aRayCount))
 FandR.setReplaceString(aReplace(aRayCount))
 aRayCount = aRayCount + 1
 oSheet.ReplaceAll(FandR)
Wend
End Sub

Re: Find & Replace Sample of multiple operations.

Posted: Tue Nov 13, 2012 12:42 am
by karolus
Hallo

Code: Select all

oSheet = oDoc.getSheets.getByName(oDoc.CurrentSelection.Spreadsheet.Name)
Why so sophisticated ?
Get the Sheet-object directly with:

Code: Select all

osheet = odoc.CurrentSelection.Spreadsheet
Karolus

Re: Find & Replace Sample of multiple operations.

Posted: Tue Nov 13, 2012 2:05 am
by JohnV
Get the Sheet-object directly with:
osheet = odoc.CurrentSelection.Spreadsheet
Does seem a lot simpler. Now if I can just remember it because I think you or somebody else pointed this out once before.

Re: Find & Replace Sample of multiple operations.

Posted: Tue Nov 13, 2012 11:29 am
by Arcadius
Hey guys - it works like a charm !

You're just super dooper :-)

Thanks a lot, I'll be sleeping a lot better tonight !

Re: Find & Replace Sample of multiple operations.

Posted: Mon Oct 06, 2014 10:54 am
by phmagnabosco
Hi all,
I found your code while looking for a way to convert numeric tones of Mandarin Chinese into Pinyin in an excel sheet.
I use it to build vocabulary lists.

I works well, so thank you guys! It is so much easier to enter the numeric tones and then run the macro than to enter the accent marks one by one.

Just in case anyone is interested (or does the google search I just did), here is the code below.

It will convert syllables such as kuai4, mang2, hao3, er4, nv3
to kuài, máng, hǎo, èr, nǚ.

Code: Select all

Sub NumTonestoPinyin_Calc
Dim oDoc,aFind,aReplace,aRayCount,FandR,oSheet
oDoc = ThisComponent
aFind = Array("r1", "r2", "r3", "r4", "n1", "n2", "n3", "n4", "ng1", "ng2", "ng3", "ng4", "ai1", "ai2", "ai3", "ai4", "ei1", "ei2", "ei3", "ei4", "ao1", "ao2", "ao3", "ao4", "ou1", "ou2", "ou3", "ou4", "a1", "a2", "a3", "a4", "e1", "e2", "e3", "e4", "i1", "i2", "i3", "i4", "o1", "o2", "o3", "o4", "u1", "u2", "u3", "u4", "ü1", "ü2", "ü3", "ü4", "v1", "v2", "v3", "v4")
aReplace = Array("1r", "2r", "3r", "4r", "1n", "2n", "3n", "4n", "1ng", "2ng", "3ng", "4ng", "a1i", "a2i", "a3i", "a4i", "e1i", "e2i", "e3i", "e4i", "a1o", "a2o", "a3o", "a4o", "o1u", "o2u", "o3u", "o4u", "ā", "á", "ǎ", "à", "ē", "é", "ě", "è", "ī", "í", "ǐ", "ì", "ō", "ó", "ǒ", "ò", "ū", "ú", "ǔ", "ù", "ǖ", "ǘ", "ǚ", "ǜ", "ǖ", "ǘ", "ǚ", "ǜ")
aRayCount = 0
osheet = odoc.CurrentSelection.Spreadsheet
FandR = oSheet.createReplaceDescriptor
FandR.SearchCaseSensitive = true
FandR.SearchWords = false ' 1 to A AND 11 to AA
FandR.SearchRegularExpression = true
While aRayCount <= uBound(aFind)
FandR.setSearchString(aFind(aRayCount))
FandR.setReplaceString(aReplace(aRayCount))
aRayCount = aRayCount + 1
oSheet.ReplaceAll(FandR)
Wend
End Sub


Re: Find & Replace Sample of multiple operations.

Posted: Sat Mar 19, 2016 12:40 am
by jjjjjjj7
JohnV wrote:
Could anyone please tell me, how to do the same in my spreadsheet, in Calc ??
Here's some modified code that will work in Calc.

Thank you for the code to replace in Calc. I'd like to adjust the list of my variing terms to search and to replace easily, without touching the code. For example working on spreadsheet 1 and referring to the listing of the search terms in column 1 of spreadsheet 2 and the corresponding replace terms in columns number 2 of spreadsheet 2?
Thank you for your help