Avatar billede bkhansen Novice
24. februar 2015 - 08:52 Der er 15 kommentarer

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

Hej.

Jeg har ca. 10.000 linjer med meta-beskrivelser. Beskrivelserne er generet via noget data fra Axapta.

Der er en del fejl i disse beskrivelser, så jeg har brug for en funktion der kan fjerne noget tekst.

Køb XX og XX online til billige priser. Harboe EnergyHarboe Energy drink er en koffeinholdig energidrik, som XXXXXXX ...

Jeg har brug for at få fjernet det første "Harboe Esnergy" tekst ...

Hvordan ville i løse denne?

Mvh Brian
24. februar 2015 - 09:00 #1
Søg og Erstat

Søg efter: Harboe EnergyHarboe Energy
Erstat med: Harboe Energy
24. februar 2015 - 09:02 #2
Søg efter: billige
Erstat med: lave

Varer kan være billige - det kan priser ikke.
Avatar billede bkhansen Novice
24. februar 2015 - 09:21 #3
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 ...
24. februar 2015 - 09:31 #4
Hvad med at rette fejlen i Axapta-udtrækket?
Avatar billede bkhansen Novice
24. februar 2015 - 09:44 #5
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 :-)
Avatar billede supertekst Ekspert
24. februar 2015 - 09:55 #6
Hvor mange forskellige "udtryk" skal udskiftes?
Avatar billede bkhansen Novice
24. februar 2015 - 10:02 #7
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 ...
Avatar billede supertekst Ekspert
24. februar 2015 - 10:26 #8
Er der "kun" tale om at tekstdele der er gentaget og at gentagelsen skal fjernes?
Avatar billede bkhansen Novice
24. februar 2015 - 10:34 #9
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?
Avatar billede supertekst Ekspert
24. februar 2015 - 10:45 #10
Det gør det - skulle nok være mulig via VBA.
Avatar billede supertekst Ekspert
24. februar 2015 - 13:34 #11
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.
Avatar billede kabbak Professor
24. februar 2015 - 14:44 #12
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
Avatar billede supertekst Ekspert
24. februar 2015 - 14:53 #13
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
Avatar billede supertekst Ekspert
20. marts 2015 - 17:42 #14
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
Avatar billede supertekst Ekspert
20. marts 2015 - 17:43 #15
For ræk = 67 To antalræk - rettes til 2 to ...
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester