Script VBA di Excel 2013 necessario per [chiuso]

-1

Ho diverse celle che hanno una stringa di testo in parte in grassetto e in parte NotBold. Devo eliminare la parte in grassetto del testo nelle celle

Esempio:

ExcelImage

lname1, fname1 email1@email.com

lname2, fname2 email2@email.com

lname3, fname3 email3@email.com

Vorrei cancellare il grassetto "lname, fname" e mantenere l'indirizzo e-mail nella cella.

— Rob808
fonte

Si noti che Super User non è un servizio di scrittura di script. Se ci dici che cosa hai provato finora (compresi eventuali script che stai utilizzando) e dove sei bloccato, allora possiamo provare ad aiutare con problemi specifici. Dovresti anche leggere Come faccio una buona domanda? .

— DavidPostill

Ho provato a trovare e sostituire e troverà il testo in grassetto ma quando premo Sostituisci, sostituisce l'intera cella incluso il testo non in grassetto. Non conosco alcuna funzione in Excel in grado di formattare o modificare il testo parziale in una singola cella. Poi di nuovo, sono solo il migliore intermedio con Excel.

— Rob808,

Quindi suppongo che la mia domanda sia "Come posso eliminare la parte in grassetto della stringa di testo in ogni cella"? Prima: lname1, fname1email1@email.com Dopo: email1@email.com

— Rob808,

È possibile verificare se il testo è in grassetto con Range("A1").Characters(i, 1).Font.FontStyle = "Bold"fonte: stackoverflow.com/questions/16209572/...

— Divin3

Prima:

Il codice:

Sub BoldKiller()
    Dim L As Long, r As Range, t As String, i As Long

    For Each r In Intersect(ActiveSheet.UsedRange, Selection)
        t = r.Text
        If t <> "" Then
            L = Len(t)
            For i = L To 1 Step -1
                If r.Characters(i, 1).Font.Bold = True Then
                    r.Characters(i, 1).Delete
                End If
            Next i
        End If
    Next r
End Sub

e dopo:

EDIT # 1:

Questa macro estrae i caratteri in grassetto e li posiziona nella colonna adiacente:

Sub BoldKiller2()
    Dim L As Long, r As Range, t As String, i As Long
    Dim rr As Range

    For Each r In Intersect(ActiveSheet.UsedRange, Selection)
        t = r.Text
        If t <> "" Then
            Set rr = r.Offset(0, 1)
            rr.Font.Bold = True
            L = Len(t)
            For i = L To 1 Step -1
                If r.Characters(i, 1).Font.Bold = True Then
                    rr.Value = r.Characters(i, 1).Text & rr.Value
                    r.Characters(i, 1).Delete
                End If
            Next i
        End If
    Next r
End Sub

Prima:

e dopo:

— Studente di Gary
fonte

BaryKiller, studente di Gary, tornerà molto utile. Spero che tu possa darmi un'altra soluzione. Stessi dati dall'alto ma questa volta possiamo dividere il grassetto e posizionarlo nella colonna adiacente? Quindi, avremmo lname, fname in una colonna e l'indirizzo e-mail nella colonna net.

— Rob808,

@ Rob808 Domani darò un'occhiata.

— Gary's Student,

Grazie mille. Aspetto tue notizie.

— Rob808,

@ Rob808 Vedi il mio EDIT n. 1:

— Gary's Student,

EDIT # 1 funziona perfettamente. Grazie mille.

— Rob808,