Rileva formattazione da cella

Hai un problema con Excel?

Nuova discussione

Rileva formattazione da cella
di gerry65 (utente non iscritto) data: 29/08/2017 15:31:13
Salve a tutti, dovrei formattare delle celle in una tabella, la formattazione deve essere rilevata da alcune celle in base a un codice, provo a spiegare, oltre ad allegare un file esempio. da tenere presente che la versione di excel e la 2003, ho creato due tabelle assegando un nome la prima si chiama TB_Dati, dove si inseriscono dei dati la prima colonna e nominata Codice, la seconda tabella e con il nome TB_Formato, dove la prima colonna è nominata formato, ora se nella tabella TB-Dati inserisco un codice tipo Ve spostamdomi di cella tramite VBA rilevare il codice dalla TB_Fomato ed applicare il formato trovato alla stesso codice nella TB_Dati. Il formato deve essere sia per il bordo colore e al testo.
di gerry65 (utente non iscritto) data: 29/08/2017 21:00:25
chiedo scusa, qualcuno sa se si puo realizzare la macro in descrizione.
Spero che qualcuno mi possa aiutare!
di cromagno data: 30/08/2017 10:56:45
Ciao,
ma hai provato ad usare il "registratore di macro" per ottenere le varie formattazioni?
Il lavoro che chiedi (visto che nel file non c'è traccia di codici da te provati) non è complicato quanto lungo.

Usa il registratore, come detto prima, ed otterrai le giuste proprietà da poter assegnare ad una determinata cella sfruttando l'evento "Worksheet_Change" del foglio.

Ciao
Tore
di gerry65 (utente non iscritto) data: 30/08/2017 12:09:17
Ciao cromagno grazie per aver risposto, non ho provato con il registratore di macro per i seguenti motivi:
1 le tabelle sono dinamiche, ed hanno un nome
2 non so il riferimento di cella a cosa può essere utile data che la formattazione deve avvenire in base al codice assegnato alla colonna codice, praticamente a codice uiguale assega la formattazione, copia da tabella TB_Formato, e incolla alla Tabella TB_Dati.
Scasa ma non ho idea di come si possa fare, Grazie
di cromagno data: 30/08/2017 12:19:28
Il registratore ti serve per ottenere le proprietà per la formattazione da assegnare alla cella (indipendentemente che la selezioni o rispetti certi criteri o altro).
Una volta ottenute quelle proprietà, se hai una conoscenza almeno di base del VBA, sarà uno scerzo creare il codice ad hoc.

Se invece vuoi che ti venga dato il codice e basta, allora basta dirlo chiaramente (forse è per questo che molti non hanno risposto).

In ogni caso, prima di stasera non potrò "applicarmici".

di gerry65 (utente non iscritto) data: 03/09/2017 20:36:18
cia cromagno ho provato con il registratore di macro per copiare il formato, mi ha dato il seguento codice, solo che non riesco a confrontare i codici delle due tabelle e a codice uguale incollare il formato.
spero che mi puoi dare una mano grazie

Sub CopiaFormato()

    Range("P14:AB14").Select
    Selection.Copy
    Range("P38").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

di gerry65 (utente non iscritto) data: 04/09/2017 17:03:46
cercando sul web e legendo sono riuscito a mettere insieme il seguente codice per confrontare i valori, solo che non riesco a completare il tutto,
1 dovri assegnare il nome delle tabelle per la ricerca, e non ci riesco,
2 non riesco a copiare il formato dalla 1 cella all'ultima cella della tabella, idem per icollare il formato.
3 il codice mi da l'impreesione che non si ferma continua anche dopo aver incollato il formato.
4 dovrei far partire il codice all'vento cange.
Allego il codice con la speranza che qualcuno mi possa aiutare.

Sub confronta_Copia_Formato()
For Each cella2 In Worksheets("Foglio1").Range("A8:A30")
For Each cella1 In Worksheets("Foglio1").Range("P9:P30")
If cella2.Value = cella1.Value Then
cella1.Range("b1:n1").Copy 
cella2.Range("b1").Select
Selection.PasteSpecial Paste:=xlPasteFormats
End If
Next
Next
End Sub

di Luca73 data: 04/09/2017 17:28:01
Ciao
Alcune domande per capire
1) Cit "dovri assegnare il nome delle tabelle per la ricerca, e non ci riesco," Perchè dovresti dare un nome alle tabelle di ricerca?

Alcuni suggerimenti alla cieca
1) For Each cella2 In Worksheets("Foglio1").Range("A8:A30")
Con questa istruzione assegni alla variabile cella2 una per una tutte le variabili dell'intervallo Range("A8:A30") pertanto cella 2 sara A8 il ciclo dopo A9, A10,... e analogamente per cella1
Pertanto la riga cella1.Range("b1:n1").Copy non ha significato. Secondo me tu vuoi copiare semplicemente cella1
2) se vuoi che il codici si fermi glielo devi dire altrimenti lui cicla fino alla fine.
Esiste il comando exit for da inserire all'interno dell'if per il primo ciclo. Per il secondo io creerei una variabile aggiuntiva

Ho provato a correggere ma non ho testato
Ciao
Luca

Sub confronta_Copia_Formato()
Dim cella2 as Range
Dim cella1 as Range
Dim Trovata as boolean
trovata = false
For Each cella2 In Worksheets("Foglio1").Range("A8:A30")
For Each cella1 In Worksheets("Foglio1").Range("P9:P30")
If cella2.Value = cella1.Value Then
cella1.Copy 
cella2.Select
Selection.PasteSpecial Paste:=xlPasteFormats
trovata = true
exit for
End If
Next
if trovata then exit for
Next
End Sub

di gerry65 (utente non iscritto) data: 04/09/2017 20:44:23
Ciao Luca73, grazie per aver risposto, all'inizio della discussione, ho allegato un foglio di esempio senza codice, se lo puoi aprire, e provi a selezionare le tabelle vedrai che nel quadratino sopra la barra delle formule ti apparirà il nome per le due tabella, la prima e TB_Dati, la seconda è TB_Formato, dove la prima colonna di ogni tabella e codice, se io inserisco un codice nella TB_Dati appena mi sposto della cella deve iniziare il confronto con la TB_Formato se il codice esiste copia il formatto dell'inera riga e lo incolla nella TB_Dati.
Dato che il nome alle tabelle c'è come posso fare invece di usare il range di ricerca assegare il nome tabella e far la ricerca sulla colonna codicè?
Il codice da te modificato mi copia solo la cella con il codice mentre a me serve che copi tutta la riga della tabella.
Allego il file con il codice, prova a fare una prova.
Altro probela e che mi trova solo il primo codice mentre non trova gli altri codici, nella tabella ci sono più codici.

di Luca73 data: 05/09/2017 09:20:47
Se ho capito bene la Macro sotto dovrebbe funzionare.
Devi copiarla nel foglio.
Si attiva quando modifiche il foglio.
Ciao
Luca

Private Sub Worksheet_Change(ByVal Target As Range)
With Application
      .EnableEvents = False
End With
If Target.Column > 1 Then Exit Sub
If Target.Row < 9 Then Exit Sub

Dim CellaW As Range

For Each CellaW In Worksheets("Foglio1").Range("P9", Cells(Rows.Count, Range("P9").Column).End(xlUp))
    If Target.Value = CellaW.Value Then
        Range(CellaW, CellaW.Offset(0, 12)).Copy
        Target.PasteSpecial Paste:=xlPasteFormats
        Target.Offset(1, 0).Select
        Application.CutCopyMode = False
        Exit For
    End If
Next
With Application
      .EnableEvents = True
End With
End Sub

di gerry65 (utente non iscritto) data: 05/09/2017 17:54:43
Ciao Luca73 ho provato il codice adesso funziona, solo che c'è un problema, la tabella formati è sempre la stessa, ma ci posso essere più taballe da formattare sullo stesso foglio, esempio oltre alla tabella già inserita c'è un altra in questo range di cella AE11:AQ12, naturalmente la prima colonna è quella codice, come posso fare per formattare anque questa?
Da tener conto che potrei inserirne altre.

di Luca73 data: 06/09/2017 11:10:43
Ciao
Modifiva la macro come sotto
Al posto delle Celle A8 e P8 inserisci le celle in alto a sinistra delle tue tabelle dove vuoi incollare i valori
Se le tabelle fossero più di 2 basta aggiungere all'interno di UNION un altro range del tipo

Range("P8", Range("P8").End(xlDown))

Tale range è la prima colonna (di valori continui) di una tabella che cmincia in P8
CIao
Luca

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Union(Range("A8", Range("A8").End(xlDown)), Range("P8", Range("P8").End(xlDown)))) Is Nothing Then Exit Sub
With Application
      .EnableEvents = False
End With
Dim CellaW As Range

For Each CellaW In Worksheets("Foglio1").Range("P9", Cells(Rows.Count, Range("P9").Column).End(xlUp))
    If Target.Value = CellaW.Value Then
        Range(CellaW, CellaW.Offset(0, 12)).Copy
        Target.PasteSpecial Paste:=xlPasteFormats
        Target.Offset(1, 0).Select
        Application.CutCopyMode = False
        Exit For
    End If
Next
With Application
      .EnableEvents = True
End With
End Sub

di gerry65 (utente non iscritto) data: 06/09/2017 19:07:44
Grazie Luca73, ho provato il codice e funziona tutto, solo che dovrei copiare pure l'altezza della riga, e la larghezza si può fare? ho provato a vedere col il registratore di macro ma per l'altezza non è possibile, c'è un sistema per poterlo fare?
Grazie ancora

di Luca73 data: 07/09/2017 09:05:19
Ciao
prova con la modifica sotto priportata.
Attenzione che se modifiche l'altezza della riga cambia tutta la riga e pertanto se sulla stessa riga hai dei dati che usi come modello allora cambia anche quello

Per la larghezza assumo che hai capito come fare.

Ciao
Luca

Private Sub Worksheet_Change(ByVal Target As Range)
[...]
  If Target.Value = CellaW.Value Then
       Range(CellaW, CellaW.Offset(0, 12)).Copy
       Target.PasteSpecial Paste:=xlPasteFormats
       Target.Offset(1, 0).Select
       Application.CutCopyMode = False
       Target.RowHeight = CellaW.RowHeight
       Exit For
   End If
[...]
End Sub

di gerry65 (utente non iscritto) data: 08/09/2017 12:45:16
Ciao Luca73, ho provato il codice, funziona tutto, ultimo accargimento se vorrei separare la tabella formato dalle altre tabelle, tipo tabella formato nel foglio3,
mentre le altre tabelle nel foglio1 e foglio2, come posso fare.
di gerry65 (utente non iscritto) data: 10/09/2017 21:20:33
Dopo varie prove sono riuscito a risolvere con il segente rigo di codice modificato
For Each CellaW In Worksheets("Foglio3").Range("E5", Worksheets("Foglio3").Cells(Rows.Count, Worksheets("Foglio3").Range("E5").Column).End(xlUp))
di gerry65 (utente non iscritto) data: 11/09/2017 20:29:35
Risolto

Vuoi Approfondire?