Funzione CONCATENA, rispettando le formattazioni delle celle d'origine

Question

Salve  Forum,

Dopo tanto tempo che non ci sentiamo...,  mi è subentrata  una sorta di nostalgia; ecco che, per  porvi rimedio, vi pongo un quesito:

DOMANDA: La funzione "CONCATENA"  prevede il riporto dei contenuti  così come  diversamente formattati nelle varie celle di provenienza?

Esempio:  Nella  cella A1 digitiamo: 30 con tipo di carattere Arial  11;

Nella  cella B1 digitiamo : 30 con tipo di carattere Arial  15  in grassetto.;

In C1 la Funzione: =CONCATENA( A1;B1) .

La richiesta è quella di conoscere se in C1 è possibile che venga riportata la concatenazione rispettando , però, le formattazioni originali delle celle di provenienza,  nella fattispecie in esempio, così:

3030

Un saluto, Paolo

Answer 1

...

 

Però (c'è sempre un però di mezzo), ti sei dimenticato la originaria richiesta del riporto della eventuale diversa dimensione del carattere (se non ne hai più parlato vuol dire che ciò non è possibile realizzarlo, o mi sbaglio**?**

 

...

Ciao Paolo,

non mi pareva lo avessi chiesto, tant'è che all'inizio della discussione, visto che un pochino ti conosco, ti chiesi:

Un'ultima informazione.

Deve essere 'concatenato' solamente il formato grassetto o anche altre formattazioni?

Non avendo ricevuto risposta, mi sono concentrato solamente sul grassetto. Il nuovo codice, che sostituisce il precedente, 'concatena': il tipo di carattere, la dimensione, il colore, il grassetto, il corsivo e la sottolineatura.

Spero che sia sufficiente. 

Andrea.

---

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rTarget As Range, rSource As Range, cel As Range

Dim sFormula  As String

Dim p As Long, l As Long

  On Error GoTo Uffa

  Set rSource = Range("D8, E8, D9, E9, G9, H9, D10, E10, E11, D12, D5, E5, D6, E6, D7, E7")

  If Intersect(Target, rSource) Is Nothing Then Exit Sub

  Set rTarget = Worksheets("ORD - GDP IND KM").[b11]

  With Application

    .ScreenUpdating = False

    .EnableEvents = False

  End With

  For Each cel In rSource

    sFormula = sFormula & cel.Value

  Next

  rTarget.Value = sFormula

  p = 1

  For Each cel In rSource

    l = Len(cel.Value)

    If l Then

      With rTarget.Characters(p, l)

        .Font.Name = cel.Font.Name

        .Font.Size = cel.Font.Size

        .Font.Color = cel.Font.Color

        .Font.Bold = cel.Font.Bold

        .Font.Underline = cel.Font.Underline

        .Font.Italic = cel.Font.Italic

      End With

    End If

    p = p + l

  Next

exitSub:

  With Application

    .ScreenUpdating = True

    .EnableEvents = True

  End With

  Exit Sub

Uffa:

  Call MsgBox("Si è verificato il seguente errore: " & Err & vbNewLine & Err.Description)

  Resume exitSub

End Sub

---

Answer 2

Ciao, Andy, 

Ti ringrazio preliminarmente per  avermi fornito l'indirizzo su cui studiare qualcosina  (mi sarebbe servito già ieri**!). Più che il mare, sento nell'aria l'odore del Carnevale di Acireale, luogo in cui vado tutti gli anni, perché lì si respira tutta l'aria "du Brazil".**

 

...

Ciao Paolo,

... peccato solo che manchino le Brasiliane. ;)

Complimenti, comunque, anche questa volta sei riuscito a spingerti oltre i limiti delle funzionalità di excel.

Il problema, come hai giustamente fatto notare tu, si verifica quando la lunghezza del testo risultante eccede i 255 caratteri, è dovuto ad una limitazione della funzione evaluate.

Ti allego il nuovo codice che sostituisce interamente il precedente.

Buon carnevale,

Andrea.

PS:

visto che ti stai applicando per imparare il vba, ti elargisco un primo consiglio:

la prima riga che ho anche evidenziato non è opzionale ma obbligatoriae deve essere presente all'inizio di ogni modulo. Seleziona explicit e premi F1 per informazioni in merito.

---

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rTarget As Range, rSource As Range, cel As Range

Dim sFormula  As String

Dim p As Long, l As Long

On Error GoTo Uffa

Set rSource = Range("D8, E8, D9, E9, G9, H9, D10, E10, E11, D12, D5, E5, D6, E6, D7, E7")

If Intersect(Target, rSource) Is Nothing Then Exit Sub

Set rTarget = Worksheets("ORD - GDP IND KM").[b11]

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

For Each cel In rSource

sFormula = sFormula & cel.Value

Next

rTarget.Value = sFormula

p = 1

For Each cel In rSource

l = Len(cel.Value)

If l Then rTarget.Characters(p, l).Font.Bold = cel.Font.Bold

p = p + l

Next

exitSub:

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

Exit Sub

Uffa:

Call MsgBox("Si è verificato il seguente errore: " & Err & vbNewLine & Err.Description)

Resume exitSub

End Sub

---

Answer 3

Ciao Andy

Ho creato - da Inserisci - un modulo, vi ho incollato il codice ma alla chiusura del file mi appare una finestra che recita testualmente: Errore di compilazione: Previsto: Numero di riga oppure etichetta oppure istruzione oppure fine istruzione.

Cosa ho combinato**?** 

E non scatenarmi altre risate,  affermando: "e non aggiungo altro visto che ultimamente sei diventato un esperto di VBA."

Pero' devo confessarti seriamente che Norman è stato l'unico fra voi che è riuscito a farmi appassionare a questo famoso VBA. Sto cercando qualche corso di base (gratuito), per imparare almeno "i preliminari, e poi saprò darti risposta, dimostrandoti di sapere superare il/i maestri .......... ;) 

a dopo, Paolo

Answer 4

...

Ovviamente, il file posto su SkyDrive è lì  solo per aiutarti  nella comprensione del problema; l'eventuale codice avrei il piacere di inserirlo io, se non altro per fare un po' di pratica.

 

Grazie, Paolo

Ciao Paolo,

era una domanda stupida, perciò ho cancellato il post.

Copia il codice allegato nel modulo del foglio INS e non aggiungo altro visto che ultimamente sei diventato un esperto di VBA.

Buona serata,

Andrea.

---

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rTarget As Range, rSource As Range, cel As Range

Dim sFormula  As String

Dim p As Long, l As Long

On Error GoTo Uffa

Set rSource = Range("D8, E8, D9, E9, G9, H9, D10, E10, E11, D12, D5, E5, D6, E6, D7, E7")

If Intersect(Target, rSource) Is Nothing Then Exit Sub

sFormula = "=CONCATENATE(INS!D8,INS!E8,INS!D9,INS!E9,INS!G9,INS!H9,INS!D10,INS!E10,INS!E11,INS!D12,INS!D5,INS!E5,INS!D6,INS!E6,INS!D7,INS!E7)"

Set rTarget = Worksheets("ORD - GDP IND KM").[b11]

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

rTarget.Value = Evaluate(sFormula)

p = 1

For Each cel In rSource

l = Len(cel.Value)

If l Then rTarget.Characters(p, l).Font.Bold = cel.Font.Bold

p = p + l

Next

exitSub:

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

Exit Sub

Uffa:

Call MsgBox("Si è verificato il seguente errore: " & Err & vbNewLine & Err.Description)

Resume exitSub

End Sub

---

Answer 5

Andy

Non so se hai già visionato il file Originale che ho posto su SkyDrive, li potrai vedere nel Foglio  "INS" tutte le celle il cui contenuto dovrà apparire  concatenato  nel Foglio " ORD - GDP INDKM"  (te ne accorgerai dalla già inserita formula nella cella B11). Le colorate di celeste sono quelle da riportare senza la formattazione in grassetto, mentre le celle colorate in Rosso, sono quelle da riportare con formattazione in grassetto. Nessun'altra cella non colorata dovrà essere riportata-concatenata nel Foglio   "ORD - GDP INDKM".

Mi auguro di essermi spiegato sufficientemente chiaro, (ho questi dubbi perché al lavoro oggi mi hanno spremuto più del solito).

Ciao, Paolo