Keskustelu: Ohjelmointikysymykset: VBA: tekstin korvaaminen ja välilyönnit Wordissa

Hei vaan,

Olen ihan aloittelija VBA:ssa ja ongelmani koskee replace-toimintoa Wordissa.

Minun pitäisi korvata tekstissä esiintyvä merkki "R" merkillä "Rg", ja samalla säilyttää tekstirivin pituus samana. VBA:n pitäisi toisin sanoen poistaa välilyönti sen sanan jälkeen, jossa korvaaminen tapahtui. Sama ongelma on kun haluan korvata esimerkiksi "Hj" merkillä J, mutta nyt sana lyhenee, eli VBA:n pitäisi lisätä välilyönti heti sanan jälkeen.
Tällä tavoin pitäisi käydä koko asiakirja läpi.

Olen yrittänyt tehdä tätä VBA:n find/replace-toiminnoilla, mutta tuo sanan jälkeen etsittävä välilyönti menee yli osaamiskyvyn. Lisäksi olen vähän hämilläni kun VBA korvaa "Rg" ja "Hj" merkit "RG" ja "HJ"-merkeillä. Miten saan toiset kirjaimet pieneksi?

Tämmöinen olis kuumana pähkinänä täällä. Teille, arvoisat VBA-gurut, tämä ei liene lainkaan ongelma. Joten jos saisin hieman valaistusta tähän asiaan niin olisin kiitollinen

Teet niin, että et käytä replacea vaan hakua (find, instr tms) ja sitten kun löydät korvattavan merkin niin haet myös sen jälkeen löytyvän välilyönnin.

Tuossa speksissäkin on muuten sellainen ongelma, että jos sana on rivin viimeisenä ja siinä ei ole välilyöntiä, niin välilyönnin poistaminen R -> Rg korvauksen jälkeen ei luonnollisesti ole mahdollista. Voihan tietty olla että siinä on välilyönti aina ennen rivinvaihtoa tms.

Moikka ak77116!

esim. vaikka näin...

Sub Korvaa()

   Application.ScreenUpdating = False
   For Each aWord In ActiveDocument.Words
      If Len(aWord) > 1 And Left(aWord, 1) _
      = "R" And Mid(aWord, 2, 1) <> "g" Then
         aWord.Select
         Dim bWord: bWord = Selection.Text
         bWord = Replace(bWord, "R", "Rg")
         Selection.Text = bWord
         With Selection.Range
           .MoveEnd Unit:=wdCharacter, Count:=-1
         End With
         If InStr(Selection.Range.Text, " ") > 0 Then
           Selection.Range.Text = _
           Replace(Selection.Range.Text, " ", "")
         End If
      End If
   Next
   Application.ScreenUpdating = True

End Sub

Vautsi! Kiitoksia vaan tuhannesti!

Tuossa tuli kyllä niin paljon uusia termejä etten oikein pysy mukana, mutta hienostihan se toimii. Pitää googlata noita funktiota niin jospa tuo logiikka avautuis mullekin. Pitää siis unohtaa tuo find/replace yhdistelmä.

Sitten vielä jatkokysymys:

Jos esim. tekstissä oleva R korvataan Rg:llä, ja teksti "Rg" korvataan merkillä "Ke", niin ollaan tilanteessa, jossa tekstissä esiintyy jo korvattuja ja ei korvattuja "Rg" tekstimerkkejä. Tarkoitus olisi muuttaa ainoastaan alkuperäisessä tekstissä esiintyneet "Rg":t.

Mulla oli omassa kyhäelmässä sellainen ratkaisu, että se etsii ainoastaan punaisella merkittyjä tekstimerkkejä/sanoja dokumentista. Sitten se vaihtaa korvatun merkin värin mustaksi. Voisko tuohon koodiin ympätä sellaisen toiminnon?

Niin ja kiitokset vielä tuhannesti tuosta koodivinkistä!

P.S. tuo Replace-funktio tuossa koodissa ei näytä toimivan 2003 Wordissa mukana tulleessa VBA:ssa(en tiedä mikä versio). Voisko tuota oikaista jotenkin niin, että 2003 Wordikin sen älyäis?

P.P.S. Niin ja tosiaan siellähän pitää olla se välilyönti ennen rivin vaihtoa, jos välilyönnin haluaa poistaa rivin viimeisen sanan jälkeen. Pitää varmaan lisätä sinne välilyönnit että toimis kunnolla... Tai tehdä siihen joku koodi.

Moikka taas ak77116!

tuo Grez'n mainitsema ongelma on ja pysyy, mikäli tahdot pitää kiinni alkuperäisen tekstin pituudesta (ilman välilyöntejä ennen rivinvaihtoja)...

lisää testi koodia...

Private Sub CommandButton1_Click()

   Static i As Integer
   If i > 1 Then i = 0
   Select Case i
     Case 0: Korvaa "R", "Rg"
     Case 1: Korvaa "Hj", "J"
   End Select
   i = i + 1

End Sub

Sub Korvaa(a, b)

   Application.ScreenUpdating = False
   ActiveDocument.Select
   OrgLen = Len(Selection.Text)

   For Each aWord In ActiveDocument.Words
      If InStr(aWord, a) > 0 And InStr(aWord, b) = 0 Then
         aWord.Select: bWord = Selection.Text
         bWord = replace(bWord, a, b)
         If Len(a) < Len(b) Then
            Selection.Text = bWord
            With Selection.Range
              .MoveEnd Unit:=wdCharacter, Count:=-1
            End With
            If InStr(Selection.Range.Text, " ") > 0 Then
              Selection.Range.Text = _
              replace(Selection.Range.Text, " ", "")
            End If
         ElseIf Len(a) > Len(b) Then
            With Selection.Range
              .MoveEnd Unit:=wdCharacter, Count:=-1
            End With
            Selection.Range.Text = bWord & " "
         Else
            Selection.Range.Text = bWord
         End If
      End If
   Next

   Application.ScreenUpdating = True
   ActiveDocument.Select
   NewLen = Len(Selection.Text)
   MsgBox OrgLen & " " & NewLen

End Sub

Voisit myös kokeilla RegExp (Regular Expression) funktiota...ko. funktio ei ole integroituna VBA:ssa, mutta VBScript-enginen avulla onnistuu...

'Module1
Option Explicit
#Const LateBind = True

Function RegExpSubstitute(ReplaceIn, _
ReplaceWhat As String, ReplaceWith As String)

    #If Not LateBind Then
      Dim RE As RegExp
      Set RE = New RegExp
    #Else
       Dim RE As Object
       Set RE = CreateObject("vbscript.regexp")
    #End If

    RE.Pattern = ReplaceWhat
    RE.Global = True
    RegExpSubstitute = RE.replace(ReplaceIn, ReplaceWith)

End Function

Function RegExpFind(FindIn, FindWhat As String, _
Optional IgnoreCase As Boolean = False)

    Dim i As Long

    #If Not LateBind Then
       Dim RE As RegExp, allMatches As MatchCollection, aMatch As Match
       Set RE = New RegExp
    #Else
       Dim RE As Object, allMatches As Object, aMatch As Object
       Set RE = CreateObject("vbscript.regexp")
    #End If

    RE.Pattern = FindWhat
    RE.IgnoreCase = IgnoreCase
    RE.Global = True
    Set allMatches = RE.Execute(FindIn)

    ReDim rslt(0 To allMatches.Count - 1)

    For i = 0 To allMatches.Count - 1
        rslt(i) = allMatches(i).Value
    Next i

    RegExpFind = rslt

End Function

Private Sub CommandButton1_Click()
   Korvaa "R", "Rg"
End Sub

Sub Korvaa(a, b)

   ActiveDocument.Select
   Teksti = Selection.Text
   Selection.Text = RegExpSubstitute( _
   Teksti, CStr(a), CStr(b))

End Sub

Ok, hyvä palvelu täällä kyllä on! Kiitos taas!

Täytyy taas vähän aikaa sulatella ja tutkia mitä nuo kaikki koodit oikein tarkoittaa...:)

-Ak77116-