macro merge celle con variabile

Hai un problema con Excel?

Nuova discussione

macro merge celle con variabile
di kikkigellu (utente non iscritto) data: 19/02/2016 19:31:37
Ciao a tutti,

avrei la necessità di unire le celle di più colonne con una macro, al variare del valore di una cella.
cerco di spiegarmi meglio:

se b7<$g$1, unisce celle d7,e7,f7 --> d7:f7
se b8<$g$1, unisce celle d7,e7,f7,d8,e8,f8 --> d7:f8
se b9<$g$1, unisce celle d7,e7,f7,d8,e8,f8,d9,e9,f9 --> d7:f9

e così via..

esiste un modo per farlo in automatico?
se può essere d'aiuto vi allego il codice vba della macro registrata per unire le celle

(ho un file da condividere ma non so come caricarlo.. scusate l'inesperienza)

grazie mille anticipatamente

Sub unisci()
'
' unisci Macro
'

'
    Range("D6:F7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
End Sub

di Albatros54 data: 19/02/2016 19:35:16
In alto a DX click su "Allega un File" possibilmente in RAR o come file di excel
di patel data: 20/02/2016 09:48:23
nel file mostra anche il risultato desiderato
di kikkigellu (utente non iscritto) data: 20/02/2016 11:35:16
non avevo visto scusate :D

ho allegato il file, spero sia d'aiuto
di patel data: 20/02/2016 13:46:40
ma tu non le vuoi soltanto unire ma anche sommare se ho capito bene
di Kikkigellu (utente non iscritto) data: 20/02/2016 13:57:57
Be unire automaticamente è la cosa che non riesco a fare..sommare non è un problema, credo di poter risolvere anche attraverso delle formule o macro registrate.
La mia difficoltà è unire più celle in tre colonne a seconda di una variabile (nel mio caso l'orario). :(

di patel data: 20/02/2016 14:15:29
prova questa

Sub a()
ora = Range("G1")
somma = 0
For r = 7 To 23
  If Cells(r, "B") = ora Then Exit For
  somma = somma + Cells(r, "D")
Next
r = r - 1
Range("E7") = somma
With Range("E7:F" & r)
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
   .MergeCells = False
   .Merge
End With
With Range("E7:F23").Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -4.99893185216834E-02
    .PatternTintAndShade = 0
End With
With Range("E7:F" & r).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0.399975585192419
    .PatternTintAndShade = 0
End With
End Sub

di kikkigellu (utente non iscritto) data: 20/02/2016 14:52:30
grandissimo!!! l'ho adattato leggermente ma funziona perfettamente (addirittura il colore!!!) grazie mille :)

Sub a()
ora = Range("G1")
somma = 0
For r = 7 To 23
  If Cells(r, "B") = ora Then Exit For
  somma = somma + Cells(r, "D")
Next
r = r - 1
Range("d7") = somma
With Range("d7:F" & r)
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
   .MergeCells = False
   .Merge
End With
With Range("d7:F23").Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -4.99893185216834E-02
    .PatternTintAndShade = 0
End With
With Range("d7:F" & r).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0.399975585192419
    .PatternTintAndShade = 0

End With
End Sub

di patel data: 20/02/2016 16:44:41
secondo me hai fatto male a usare D7, così perdi i dati di partenza

Vuoi Approfondire?