excel 2003: ordinare un foglio con celle unite

[karug64]

Salve a tutti.
Nel mio foglio, tramite una macro vba, provvedo a copiare tutte le righe dei vari TAB, secondo alcuni criteri, su un TAB chiamato Riepilogo. La composizione delle colonne è cosi strutturata: da A ad F normali, da G a K unite, da L ad O normali.
A fine elaborazione cerco di ordinare il foglio su colonne A e B, ma ricevo errore "Per il completamento dell'operazione è necessario che le celle unite siano delle stesse dimensioni" (problema che si presenta, ovviamnete, anche se provo a ordinare il foglio manualmente).
Non c'e' soluzione al problema ? Come si puo' ordinare un foglio cosi' composto ?
Grazie.

[Flash30005]

Si,
togliere le celle unite

[karug64]

Si,
togliere le celle unite

... quindi non si puo' ..... giusto ?

[Flash30005]

Non trovo altra soluzione

Oppure, se può andare bene
registri una macro che elimina la prima cella unita (G1:K1)
copi il formato fino a Gx:Kx
Selezioni da A1 a Ox
ordini con riga intestazione
selezioni di nuovo G1:K1 e unisci di nuovo le celle
copi il formato per le altre in basso
fermi la macro
e posti il codice generato


ciao

[karug64]

Non trovo altra soluzione

ciao

Potresti dirmi, allora, se tramite un ciclo for vba, dopo aver copiato le singole righe dal foglio1 al foglio riepilogo, si puo' fare questo:

1) dividere, per ogni "n" riga le celle da G a K (tramite ciclo for, immagino)
2) ordinare il foglio su colonna A e B
3 riunire (tramite ciclo for, immagino) le celle da G a K attribuendo "giustifica" ed "alineamento in alto" alle celle unite .

Grazie

[Flash30005]

sono andato in edit modificando il post mentre scrivevi
(leggi il pos precedente)

il codice lo potrai ricavare da solo
registrando una macro
poi posti il codice per adattare il numero di righe ad eventuali incrementi e rendere la macro valida per il futuro

ciao

[Flash30005]

Una macro possibile potrebbe essere questa

Codice: Seleziona tutto

Sub OrdinaConUnione()
UR = Range("A" & Rows.Count).End(xlUp).Row
    Range("G1:K" & UR).UnMerge
    Range("A1:O" & UR).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G1:K1").Select
    Selection.Merge
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Copy
    Range("G2:K" & UR).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

[karug64]

Una macro possibile potrebbe essere questa

Codice: Seleziona tutto

Sub OrdinaConUnione()
UR = Range("A" & Rows.Count).End(xlUp).Row
    Range("G1:K" & UR).UnMerge
    Range("A1:O" & UR).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G1:K1").Select
    Selection.Merge
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Copy
    Range("G2:K" & UR).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

Miiiiii !!! (vedi Giovanni di Aldo Giovanni e Giacomo) piu' veloce del generatore di macro, sei stato !!!!
Ok la routine funziona.
Occorrerebbe fare in modo che:
1) tolga tutti i bordi alle celle copiate
2) ordini su colonna A e B
3) che le celle unite siano con "testo a capo".

Infine ... chicca delle chicche ... è possibile alla fine della routine fare in modo che le righe si adattino al contenuto della cella piu' alta ? (cioe' se nelle celle unite c'e' del testo che va a capo alla fine dell'eleborazione vedo sempre la prima rga, poi devo allargare la riga e vedo tutto il contenuto) E' possibile farlo automaticamente per tutte le righe ?
Grazie

[Flash30005]

Prova così e leggi nota all'interno mdella macro

Codice: Seleziona tutto

Sub OrdinaConUnione()
UR = Range("A" & Rows.Count).End(xlUp).Row
    Range("G1:K" & UR).UnMerge
    Range("A1:O" & UR).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G1:K1").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xltop
        .WrapText = True
        .MergeCells = True
    End With
    Selection.Copy
    Range("G2:K" & UR).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Rows("1:" & UR).RowHeight = 30 '<<<<<<<< aumentare o diminuire questo valore
    Range("A1").Select
End Sub

Per l'adattamento con le celle unite ci sono dei problemi ma puoi adattare il valore 30 che vedi nella riga evidenziata

ciao

EDIT ho dimenticato il problema bordi copiati
Provvederò!!!

[Flash30005]

Questa dovrebbe andare bene

Codice: Seleziona tutto

Sub OrdinaConUnione()
UR = Range("A" & Rows.Count).End(xlUp).Row
    Range("G1:K" & UR).UnMerge
    Range("A1:O" & UR).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G1:K1").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .MergeCells = True
    End With
    Range("G2:K2").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .MergeCells = True
    End With
        Range("G3:K3").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .MergeCells = True
    End With
    Selection.Copy
    Range("G4:K" & UR).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Rows("2:" & UR).RowHeight = 40
    Range("A1").Select
End Sub

[karug64]

Questa dovrebbe andare bene

Codice: Seleziona tutto

Sub OrdinaConUnione()
UR = Range("A" & Rows.Count).End(xlUp).Row
    Range("G1:K" & UR).UnMerge
    Range("A1:O" & UR).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G1:K1").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .MergeCells = True
    End With
    Range("G2:K2").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .MergeCells = True
    End With
        Range("G3:K3").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .MergeCells = True
    End With
    Selection.Copy
    Range("G4:K" & UR).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Rows("2:" & UR).RowHeight = 40
    Range("A1").Select
End Sub

Intanto grazie.
Quindi non esiste un "autoresize" per le celle unite ? E se non avessi celle unite esisterebbe ?

P.S.
Ehm ... ci sarebbe l'ordinamento anche su colonna B ....

P.S2
E' sorto un problema: ora mi da questo errore:
"Errore nel metodo select per la classe range alla riga Range(A1:o" & UR).select ..

[Flash30005]

Macro implementata per l'ordinameno A e B

Codice: Seleziona tutto

Sub OrdinaConUnione()
UR = Range("A" & Rows.Count).End(xlUp).Row
    Range("G1:K" & UR).UnMerge
    Range("A1:O" & UR).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
    Range("G1:K1").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .MergeCells = True
    End With
    Range("G2:K2").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .MergeCells = True
    End With
        Range("G3:K3").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .MergeCells = True
    End With
    Selection.Copy
    Range("G4:K" & UR).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Rows("2:" & UR).RowHeight = 40
    Range("A1").Select
End Sub

Per l'autoresize penso che se non fossero unite avvenga automaticamente

ciao

[Anthony47]

Ma che senso ha unire "le colonne G:K" (tutte le celle delle colonne)? Non ti basta allargare la colonna G per farla larga quanto vuoi?
Se invece l' unione riguarda solo le righe della testata allora ordinare solo le righe con dati non basta??

A volte mi pare che vi piace inventare problemi inutili per poi risolverli...

[karug64]

Ciao Anthony.
Il problema e' che il mio foglio contiene dati diversi tra testata e corpo. La testata contiene piu' campi del corpo (da qui la necessita' di unire alcune celle del corpo in cui, invece, da scritto del testo descrittivo con bisogno di spazio). Quindi se allargo la colonna G per ottenere la giusta dimensione, la corrispondente colonna della testata che contiene una data (01/01/0001) si allarga a dismisura, ma soprattutto le colonne da K in poi escono dal foglio (che ha gia' margini dx e sx posti a zero ed e' ridotto all'85%). Potrei ridurre ancora di piu' il tutto ma poi diventerebbe, in stampa, poco leggibile.
Spero di essermi spiegato bene.
Grazie

[Anthony47]

Quindi non hai le colonne "da G a K unite", ma solo alcune celle e non nella testata ma nel corpo dei dati... Forse dovresti fare differenza tra fogli da visualizzare (dove le colonne unite fanno il loro onesto lavoro) e fogli da elaborare (dove le colonne unite mostrano il loro subdolo comportamento).

Ciao

[karug64]

Quindi non hai le colonne "da G a K unite", ma solo alcune celle e non nella testata ma nel corpo dei dati...

Perfetto.

Forse dovresti fare differenza tra fogli da visualizzare (dove le colonne unite fanno il loro onesto lavoro) e fogli da elaborare (dove le colonne unite mostrano il loro subdolo comportamento).

Ciao

Purtroppo non e' possibile. Testata e corpo formano una scheda cliente che va stampata cosi' (tetsta + corpo). L'eleborazione che poi faccio ( o tento di fare ) preleva tutte le righe dei corpi delle varie schede (sono oltre 100 TAB diversi) e crea un unico foglio (riepilogo) in cui vengono elencate tutte le righe dei corpi dei vari TAB.

Comunque grazie per i consigli.

Ciao

[Flash30005]

L'eleborazione che poi faccio ( o tento di fare)

Ma non va bene nemmeno la macro nel post delle ore 11:21 ?

[karug64]

L'eleborazione che poi faccio ( o tento di fare)

Ma non va bene nemmeno la macro nel post delle ore 11:21 ?

Avevo postato questo:

E' sorto un problema: ora mi da questo errore:
"Errore nel metodo select per la classe range alla riga Range(A1:o" & UR).select ..

e non volendo "fracassare" più di tanto ......

ho provato con questa routine scritta di fretta e furia

Codice: Seleziona tutto

Sub NomiUnivoci_new()
   
    For x = 0 To 29
        benef(x) = ""
    Next x
       
    ' trovo la prima riga del corpo (la cerco per evitare che se qualcuno
    ' inserisce o elimina righe nella testata ...)
    PR = 0
    For xben = 1 To 500
        If Trim(Cells(xben, 10).Value) = "Beneficiario finale" Then
            PR = xben + 1
            Exit For
        End If
    Next xben

    ' trovata l'intestazione con PR > 0 ora leggo le righe del corpo
    If PR > 0 Then
    UR = Range("J" & Rows.Count).End(xlUp).Row
        For y = PR To UR
            ' nella cella c'e' un valore
            If Len(Trim(Cells(y, 10).Value)) <> 0 Then
                testben = ""
                testben = Trim(Cells(y, 10).Value)
                ' trovo l'ultimo elemento inserito nell'array
                    For yy = 0 To 29
                        If Len(Trim(benef(yy))) = 0 Then
                            ultimo = yy
                            Exit For
                        End If
                    Next yy
                       
                ' cerco il nome nell'array
                trov = 0
                For y1 = 0 To 29
                    If benef(y1) = testben Then trov = 1
                Next y1
                If trov = 0 Then
                    If ultimo = 0 Then
                        benef(ultimo) = testben
                    Else
                        benef(ultimo) = testben
                    End If
                End If
    End If
Next y

    ' ora cancello le celle riepilogative e poi riscrivo l'array
    For be = 9 To PR - 2
        Cells(be, 10).Value = ""
    Next be
           
    For be = 0 To ultimo
        If Len(Trim(benef(be))) <> 0 Then
            Cells(be + 9, 10).Value = benef(be)
        End If
    Next be
    End If

End Sub

sicuramente migliorabile (non sistema in ordine alfabetico i nomi, per esempio) , ma sembra funzionare (pur con le sue evidenti limitazioni ...)

Pensate possa essere una soluzione alternativa ?

Grazie

[karug64]

Scusate risposta da inserire nel post "Ottenere i presenti di una colonna". Se il moderatore puo' modificare ... grazie.

[Flash30005]

A me non dà nessun errore e non posso fare tentativi con fogli disuguali al tuo

Allego file test

ciao