unione celle a condizione

[musquePartecipante musque]

Buongiorno, avrei necessità di una macro che soddisfi le seguenti condizioni su un file pdf convertito in Excel per gestire una tabella.

Nella colonna A ho la data; nella colonna B il testo. Il convertitore ha diviso il testo in tante righe e pertanto dovrei unirle in una sola cella. La condizione dovrebbe essere la seguente:

A1 trova la data e copia il testo di B1 in C1; A2 trova vuoto ed aggiunge il testo di B2 in C1; A3 trova vuoto ed aggiunge il testo di B3 in C1; e cosi via... A5 trova nuovamente la data e interrompe la funzione..

Allego un file esempio.

Grazie

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 58 pts]

Ciao, prova così:

Option Explicit

Sub unisci()
    Dim urA As Long, urB As Long
    Dim i  As Long, j As Long, k As Integer
    Dim rng As Range, c As Range
    Dim s As String
    
    urA = Cells(Rows.Count, "A").End(xlUp).Row
    urB = Cells(Rows.Count, "B").End(xlUp).Row
    
    For k = 2 To urA
        If Cells(k, "A").Value <> "" Then
            j = k
            Set rng = Range("A" & j & ":A" & Range("A" & j).End(xlDown).Row - 1)
            If rng.Rows.Count > urB Then
                Set rng = Range("A" & j & ":A" & urB)
            End If
           
            For Each c In rng
                s = s & c.Offset(, 1).Value
            Next c
            
            Cells(j, 3).Value = s
            s = ""
        End If
    Next k
    Set rng = Nothing
    MsgBox "Fatto!", vbInformation
End Sub

[alfrimpaPartecipante alfrimpa Karma: 33 pts]

Se disponi di Excel 365 potresti usare in C1 TESTO.UNISCI() accoppiato con un SE()

=SE(A2<>"";TESTO.UNISCI(";";;B2:B6);"")

e ricopi in basso

[alexps81Moderatore alexps81 Karma: 58 pts]

Ciao, anche con mono ciclo:

Sub unisci_2()
    Dim ur As Long, i As Long
    Dim s As String
    ur = Cells(Rows.Count, "B").End(xlUp).Row
    
    For i = ur To 2 Step -1
        If Cells(i, "A").Value = "" Then
            s = s & Cells(i, "B").Value
        Else
            s = s & Cells(i, "B").Value
            Cells(i, "C") = StrReverse(s)
            s = ""
        End If
    Next i
End Sub

[musquePartecipante musque]

Grazie. Funziona perfettamente già la prima istruzione!   

[Autore]

Articoli