Jeg skal slette noget i en tekst streng - men ...

Søg og Erstat

Søg efter: Harboe EnergyHarboe Energy
Erstat med: Harboe Energy

Søg efter: billige
Erstat med: lave

Varer kan være billige - det kan priser ikke.

Hej.

Dette er bare et eksempel.

Næste linje kan hedde:

Køb XX og XX online til billige priser. Multivitamin pillerMultivitamin piller, som XXXXXXX ...

Hvad med at rette fejlen i Axapta-udtrækket?

Det er som sådan ikke en fejl i Axapta - det er en længere forklaring :-)

Vi vil gerne kunne rette det i dette excel udtræk :-)

Hvor mange forskellige "udtryk" skal udskiftes?

Det er ca. 10.000 linjer ... Og vil tro der er 8000 "udtryk" der skal skiftes ... Så jeg har brug for et script eller noget lign der kan fixe det ...

Er der "kun" tale om at tekstdele der er gentaget og at gentagelsen skal fjernes?

I dette tilfælde ville jeg gerne have fjernet det første Harboe Energy: 
Køb XX og XX online til billige priser. Harboe EnergyHarboe Energy drink er en koffeinholdig energidrik, som XXXXXXX ...

I dette tilfælde ville jeg gerne have fjernet det første Multivitamin piller:
Køb XX og XX online til billige priser. Multivitamin pillerMultivitamin piller, som XXXXXXX ...

Håber det giver mening?

Det gør det - skulle nok være mulig via VBA.

Hvis du har mulighed for det er du velkommen til at sende et repræsentivt udsnit af filen / model.
@-adresse under min profil.

Er specielt interesseret i karakteristika for den kontekst, der indeholder dubletten.

Prøv denne funktion

Public Function Ret(Tekst As Range)
    Dim I As Integer, StartSted As Integer, Ord As String, SlutSted As Integer
    For I = 1 To Len(Tekst) - 1

        If Mid(Tekst, I, 1) <> " " And Mid(Tekst, I + 1, 1) <> "." And Mid(Tekst, I + 1, 1) <> " " Then
            Debug.Print Mid(Tekst, I, 1) & Mid(Tekst, I + 1, 1)
            If Mid(Tekst, I, 1) = LCase(Mid(Tekst, I, 1)) And Mid(Tekst, I + 1, 1) = UCase(Mid(Tekst, I + 1, 1)) Then
                StartSted = I + 1

                For a = 1 To Len(Tekst)
                    If Mid(Tekst, I + a, 1) = " " Then Exit For
                    Ord = Mid(Tekst, StartSted, a)
                Next

                For y = I To 1 Step -1
                    If Mid(Tekst, y - Len(Ord), Len(Ord)) = Ord Then
                        SlutSted = (y - Len(Ord))
                        Exit For
                    End If
                Next

                Exit For
            End If

        End If
    Next

    Ret = Left(Tekst, SlutSted) & Right(Tekst, Len(Tekst) - StartSted)
End Function

Alternativ:
Dim tabel As Variant, part As String
Public Sub søgOgErstat()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    Application.ScreenUpdating = False
   
    For ræk = 1 To antalRæk
        tekst = Range("A" & ræk)
        nyTekst = undersøgTekst(tekst)
        Range("B" & ræk) = nyTekst
    Next ræk

End Sub
Private Function undersøgTekst(tekst)
Dim px As Integer
    tabel = Split(tekst, " ")
   
    For x = 0 To UBound(tabel)
        part = tabel(x)
        px = findesInæste(part, x + 1)
       
        If px > 0 Then
            undersøgTekst = samlingAfTekst(part, x)
            Exit Function
        End If
    Next x
End Function
Private Function findesInæste(tekst, ix)
Dim p As Integer
    p = InStr(tabel(ix), tekst)
    findesInæste = p
End Function
Private Function samlingAfTekst(tekst, ix)
Dim x As Integer
    samlingAfTekst = ""
   
    For x = 0 To UBound(tabel)
        If x <> ix + 1 Then
            samlingAfTekst = samlingAfTekst & tabel(x) & " "
        End If
    Next
End Function

Rem Version 1
Dim tabel As Variant, part As String, p As Integer, lgd As Integer, t As String, tekst As String
Dim indledning As String, tæller As Long
Const tekstEfter = "til billige priser. "
Public Sub søgOgErstat()
    antalræk = ActiveCell.SpecialCells(xlLastCell).Row
    Application.ScreenUpdating = False
    lgd = Len(tekstEfter)
    tæller = 0
   
    For ræk = 67 To antalræk
        t = Range("F" & ræk)
        If t <> "" Then
            p = InStr(t, tekstEfter)
       
            If p > 0 Then
                indledning = Left(t, p - 1) & tekstEfter
                tekst = testVersalUdenBlank(Mid(t, p + lgd))
               
                nytekst = undersøgTekst(tekst)
                If nytekst <> "" Then
                    Range("G" & ræk) = indledning & nytekst
                    tæller = tæller + 1
                End If
            End If
        End If
    Next ræk

MsgBox "Antal justerede rækker: " & tæller & "/" & antalræk
End Sub
Private Function testVersalUdenBlank(tekst)
Dim lgd As Integer, f As Integer, tegn As String, tegn2 As String
    For f = 1 To Len(tekst)
        tegn = Mid(tekst, f, 1)
        If f < Len(tekst) Then
            tegn2 = Mid(tekst, f + 1, 1)
Rem Test om tegn2 er versal og tegn <> blank
            If tegn <> " " And UCase(tegn2) = tegn2 And Asc(UCase(tegn2)) >= 65 And Asc(UCase(tegn2)) <= 91 And Asc(UCase(tegn)) >= 65 And Asc(UCase(tegn)) <= 91 Then
                tekst = Left(tekst, f) & " " & Mid(tekst, f + 1)
            End If
        End If
    Next f
    testVersalUdenBlank = tekst
End Function
Private Function undersøgTekst(tekst)
Dim px As Integer, prePart As String
Dim p1 As Integer

    tabel = Split(tekst, " ")
    p1 = 0
    px = 0
   
    For x = 0 To UBound(tabel)
        part = tabel(x)
        px = findesPartIRest(part, x + 1)
       
        If px > 0 Then
            If x = 0 Then
                p1 = px
            Else
                If x = p1 - 1 Then
                    undersøgTekst = samlingAfTekst(p1, UBound(tabel))
                    Exit Function
                End If
            End If
        End If
    Next x
End Function
Private Function findesPartIRest(part, x)
    For f = x To UBound(tabel)
        If part = tabel(f) Then
            findesPartIRest = f
            Exit Function
        End If
    Next f
    findesPartIRest = 0
End Function
Private Function samlingAfTekst(fraIx, tilIX)
Dim x As Integer
    samlingAfTekst = ""
   
    For x = fraIx To tilIX
        samlingAfTekst = samlingAfTekst & tabel(x) & " "
    Next
End Function

For ræk = 67 To antalræk - rettes til 2 to ...