Unmerge delle celle

Question

Buongiorno a tutti.

Avrei bisogno di una routine / macro che mi permetta di fare questo:

All'interno di un foglio excel ho una tabella con molte colonne e alcune celle sono unite orizzontalmente (per intenderci, per esempio la cella c5 e d5 sono unite e contengono il valore "ROSSO").

Dovrei dividere tutte le celle unite e far si che il contenuto sia inserito in tutte le celle ottenute dalla divisione: quindi nell'esempio fatto, vorrei ottenere sia in c5 che in d5 il valore "ROSSO".

Grazie in anticipo per il vostro aiuto.

Buona giornata a tutti.

Alessandro

Answer 1

Ciao Alessandro,

Avrei bisogno di una routine / macro che mi permetta di fare questo:

All'interno di un foglio excel ho una tabella con molte colonne e alcune celle sono unite orizzontalmente (per intenderci, per esempio la cella c5 e d5 sono unite e contengono il valore "ROSSO").

Dovrei dividere tutte le celle unite e far si che il contenuto sia inserito in tutte le celle ottenute dalla divisione: quindi nell'esempio fatto, vorrei ottenere sia in c5 che in d5 il valore "ROSSO".

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim WB As Workbook 

Dim SH As Worksheet 

Dim rTabella As Range 

Dim vVal As Variant 

Dim i As Long, j As Long 

Const sFoglio As String = **"Foglio1"      '<<=== Modifica** 

Const sTabella As String = **"A1:J30"      '<<=== Modifica** 

Set WB = ThisWorkbook 

Set SH = WB.Sheets(sFoglio) 

Set rTabella = SH.Range(sTabella) 

On Error GoTo XIT 

Application.ScreenUpdating = False 

With rTabella 

    For i = 1 To .Columns.Count 

        For j = 1 To .Rows.Count 

            With .Cells(j, i) 

                If .MergeCells Then 

                    vVal = .Value 

                    With .Resize(1, .MergeArea.Columns.Count) 

                        .MergeCells = False 

                        .Value = vVal 

                    End With 

                End If 

            End With 

        Next j 

    Next i 

End With 

Call MsgBox(Prompt:="Fatto", \_ 

    Buttons:=vbInformation, \_ 

    Title:="REPORT") 

XIT:

Application.ScreenUpdating = True 

End Sub

'<<======== 

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester
• Esegui

Potresti scaricare il mio file di prova Alessandro20210922.xlsm

===

Regards,

Norman