**Funktionskrav:** Ändra indexmarkeringar på formen: **{ XE "EN 789"}** till: **{ XE "EN 789;0789"}** Dvs lägga till ett sorteringsvärde för varje indexmarkering och padda ut det till fyra siffror. Dagens ickeoptade funktion: Sub EnhanceIndexEntries() Dim doc As Document Dim fld As Field Dim temp As String Dim temp2 As String Dim omsg As String Dim matches Dim re2, re3 As RegExp Set re2 = New RegExp Set re3 = New RegExp re2.Global = False re3.Global = False re2.Pattern = "\s([0-9]{2})\W" re3.Pattern = "\s([0-9]{3})\W" Dim cnt As Integer cnt = 0 Set doc = ActiveDocument For Each fld In doc.Fields fld.Select If fld.Type = wdFieldIndexEntry Then cnt = cnt + 1 temp = fld.Code temp2 = re2.Replace(temp, " $1;00$1" & Chr$(34)) temp3 = re3.Replace(temp2, " $1;0$1" & Chr$(34)) With Selection.Find .Text = temp .Replacement.Text = temp3 .Forward = True .Wrap = wdFindStop .Format = False .Execute Replace:=wdReplaceAll End With End If Next Set fld = Nothing Set doc = Nothing omsg = "Justering av indexeringsinformation klar." MsgBox (omgs & cnt) End Sub Exempel på paddingfunktion, skrivet i det närliggande språket JScript. Nej, det är inte riktigt javascript. function padNumber(number,size){ number = new Number(number); size = parseInt(size); if(isNaN(size) || isNaN(number)) return number+""; if(number < Math.pow(10,size)){ number+=Math.pow(10,size); return (number+"").substring(1); }else{ return number+""; } } Halvoptad kod, går ~dubbelt så snabbt som den ooptade: Sub NewEnhanceIndexEntries() Dim doc As Document Dim fld As Field Dim temp As String Dim temp2 As String Dim omsg As String Dim matches As MatchCollection Dim re3 As RegExp Set re3 = New RegExp re3.Global = False re3.Pattern = "\s([0-9]{1,3})\W" Dim match As match Dim mval As String Dim cnt As Integer cnt = 0 Set doc = ActiveDocument For Each fld In doc.Fields fld.Select If fld.Type = wdFieldIndexEntry Then cnt = cnt + 1 temp = fld.Code If (re3.Test(temp) = True) Then Set matches = re3.Execute(temp) For Each match In matches mval = match.Value Next Dim size As Integer mval = Mid(mval, 2) mval = Left(mval, Len(mval) - 1) size = 4 If (Len(mval) < (size + 1)) Then Do While (Len(mval) < size) mval = "0" & mval Loop End If temp2 = Left(temp, Len(temp) - 1) temp2 = temp2 & ";" & mval & Chr$(34) With Selection.Find .Text = temp .Replacement.Text = temp2 .Forward = True .Wrap = wdFindStop .Format = False .Execute Replace:=wdReplaceAll End With Else ' NOOP End If End If Next Set fld = Nothing Set doc = Nothing omsg = "Justering av indexeringsinformation klar. Indexmarkeringar totalt: " MsgBox (omsg & cnt) End Sub