Condividi:        

MACRO ATTRIBUZIONE NOME INTERVALLO

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

MACRO ATTRIBUZIONE NOME INTERVALLO

Postdi ANTONIO1105 » 05/12/19 11:30

ho una serie di tabelle simili per struttura e funzione a questa postata.
ogni volta che debbo inserire una nuova tabella, con una macro "sposto" quella presente nell'intervallo D6:G17 verso il basso e ne inserisco una nuova vuota da compilare.
ho la necessità di fare una macro per denominare gli intervalli di volta in volta compilati in ogni tabella il cui nome è dato dall'intestazione VARIABILE delle corrispondenti colonne (D6:G6)
ad es.
all'intervallo D7:D9 va attribuito il nome presente nella D6
all'intervallo E7 va attribuito il nome presente nella E6
all'intervallo F7:f11 va attribuito il nome della cella F6
all'intervallo G7: G15 va atribuito il nome della cella G6
Registrando la macro, seleziono D6 > copia, quindi seleziono l'intervallo D7:D9 e quindi faccio incolla in alto a sx affianco alla riga di comando per attribuire il nome
La procedura funziona
Se però inserisco nello stesso intervallo una nuova tabella (identica ma vuota) spostando la precedente in basso e quindi compilando nuovi campi, quando vado ad aggiornare i nomi degli intervalli mi riporta sempre lo stesso nome attribuito inizialmente.
in altri termini, vorrei capire se c'è un nodo per attribuire di volta in volta il nome dell'intervallo presente in D6: G6 che cambia per ogni nuova tabella inserita
grazie 1000. antonio
https://www.dropbox.com/s/97f62l6azejpw ... .xlsm?dl=0
ANTONIO1105
Utente Junior
 
Post: 37
Iscritto il: 23/01/17 22:25

Sponsor
 

Re: MACRO ATTRIBUZIONE NOME INTERVALLO

Postdi Marius44 » 05/12/19 11:39

Ciao
Premetto che ho capito poco da quanto esposto ma ho scaricato il file per "vedere".
Il file ha estensione .xlsm ma in nessun modulo c'è una riga di codice.
Non vedendo la macro non posso "intuire" il problema che riscontri.

Ciao,
Mario
Marius44
Utente Senior
 
Post: 655
Iscritto il: 07/09/15 22:00

Re: MACRO ATTRIBUZIONE NOME INTERVALLO

Postdi Anthony47 » 05/12/19 16:01

Sarebbe stato meglio vedere almeno la macro che fa gli spostamenti, comunque usa questo pezzo di codice, da eseguire prima degli spostamenti di cui parli:
Codice: Seleziona tutto
Dim I As Long, J As Long   'Tra le dichiarazioni iniziali
'
For I = 4 To 7                          'Da colonna D a G
    On Error GoTo GErr
    For J = 1 To 1000                   'Esamina max 1000 righe
        If Cells(6 + J, I) = "" Then
            If J > 1 Then J = J - 1
            Cells(6 + 1, I).Resize(J, 1).Name = Cells(6, I).Value
            Exit For
        End If
    Next J
nIX:
Next I
GoTo MaCront
GErr:
MsgBox ("Nome non assegnabile: " & vbCrLf & _
   "Range=" & Cells(6 + 1, I).Resize(J, 1).Address & vbCrLf & _
   "Nome=" & Cells(6, I).Value)
Resume nIX
MaCront:
'istruzioni successive
'

Va inserito prima di fare gli spostamenti, quindi in linea di massima lo anteporrai al codice che hai gia'
In caso di impossibilita' di assegnare il Nome (es per uso di caratteri illegali) ti uscira' un messaggio con l'indicazione di errore.

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: MACRO ATTRIBUZIONE NOME INTERVALLO

Postdi ANTONIO1105 » 05/12/19 16:48

me ne scuso per nn aver inserito la macro. era semplicemete, per nn fare una figuraccia, trattandosi di una semplcie registrazione di operazioni in sequenza.
ho provato a utilizzare il tuo codice Antony ma nn ne vengo a capo. Perdonami.
Di seguito la macro che ho tentanto di costruire:
Codice: Seleziona tutto
Sub Denominatore_AggiornaItemAssegnaNomeIntervalli()
'
' Denominatore_AggiornaItemAssegnaNomeIntervalli Macro
'

'
    Application.Goto Reference:="R54C4:R1000C4"
    Selection.Copy
    Application.Goto Reference:="R54C1"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$54:$A$1000").RemoveDuplicates Columns:=1, Header:=xlNo
    ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Add2 Key:=Range( _
        "A54:A1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Ridenominatore").Sort
        .SetRange Range("A54:A1000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
With Range("E55", Range("E55").End(xlDown)).Select
End With
ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Add Key:=Range("E55"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Ridenominatore").Sort
        .SetRange Range("E55:E64")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
With Range("F55", Range("F55").End(xlDown)).Select
End With
ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Add Key:=Range("F55"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Ridenominatore").Sort
        .SetRange Range("F55:F64")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Range("G55", Range("G55").End(xlDown)).Select
End With
ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Add Key:=Range("G55"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Ridenominatore").Sort
        .SetRange Range("G55:G64")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
With Range("H55", Range("H55").End(xlDown)).Select
End With
ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ridenominatore").Sort.SortFields.Add Key:=Range("H55"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Ridenominatore").Sort
        .SetRange Range("H55:H64")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Application.Goto Reference:="R54C4"
    Selection.End(xlDown).Select
    Selection.Copy
    Range("E65:H65").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("E54").Select
    Selection.Copy
    Range("E55").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="PROVA_sub1", RefersToR1C1:= _
        "=Ridenominatore!R55C5:R65C5"
    Range("F54").Select
    Selection.Copy
    Range("F55").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="PROVA_sub2", RefersToR1C1:= _
        "=Ridenominatore!R55C6:R57C6"
    Range("G54").Select
    Selection.Copy
    Range("G55").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="PROVA_oggetto", RefersToR1C1:= _
        "=Ridenominatore!R55C7:R58C7"
    Range("H54").Select
    Selection.Copy
    Range("H55").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="PROVA_tipodoc", RefersToR1C1:= _
        "=Ridenominatore!R55C8:R59C8"
    Range("A19").Select
    Application.Goto Reference:="R46C3"
End Sub
ANTONIO1105
Utente Junior
 
Post: 37
Iscritto il: 23/01/17 22:25

Re: MACRO ATTRIBUZIONE NOME INTERVALLO

Postdi Anthony47 » 06/12/19 01:39

Nella tua macro, l'assegnazione dei nomi dovrebbe corrispondere alle righe a partire da (comprese)
Codice: Seleziona tutto
Range("E54").Select
Selection.Copy
Range("E55").Select
Range(Selection, Selection.End(xlDown)).Select

Fino alle righe (comprese)
Codice: Seleziona tutto
ActiveWorkbook.Names.Add Name:="PROVA_tipodoc", RefersToR1C1:= _
"=Ridenominatore!R55C8:R59C8"


Io dico di togliere queste righe, mentre in testa posizionerai le righe che ti ho suggerito subito prima della riga Application.Goto Reference:="R54C4:R1000C4"

Sul resto del codice dico che "se funziona va bene così"; comunque se vuoi sfidare le tue abilita' (o la sorte) guarda qui alcuni piccoli suggerimenti su come adattare una macro autoregistrata: viewtopic.php?f=26&t=103893&p=647676#p647676

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: MACRO ATTRIBUZIONE NOME INTERVALLO

Postdi ANTONIO1105 » 06/12/19 09:34

grazie 1000 antony. appena torno dal lavoro mi cimenterò. e, soprattutto, ho dato un'occhiata al tuo "invito". mi pare molto chiaro e dunque di stimolo. comincerò da lì
saluti antonio
ANTONIO1105
Utente Junior
 
Post: 37
Iscritto il: 23/01/17 22:25


Torna a Applicazioni Office Windows


Topic correlati a "MACRO ATTRIBUZIONE NOME INTERVALLO":


Chi c’è in linea

Visitano il forum: Nessuno e 93 ospiti