Applicare formula R1C1

Anonimo
2022-01-04T23:13:34+00:00

Salve,

premetto che sto cercando di fare un passo in avanti nella programmazione VBA, ma mi accorgo che è un tantino complicato.

Ho la seguente figura:

quello che vorrei ottenere, facendo doppio click sulla cella A1, è prendere le formule dall'intervallo di celle E1 : N1 ed inserirle nell'intervallo di celle C6 : L6.

Successivamente, facendo doppio click sempre sulla cella A1, man mano passare alla riga successiva aumentando (tramite formula) di una unità il valore di ogni cella.

Ho abbozzato il seguente codice (strampalato):

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim srcRng As Range, destRng As Range, preRng As Range, rCell As Range 

Const sFoglio\_Destinazione As String = "Foglio1" 

Const sDestinazione As String = "C6:L6" 

Const sPrelievo As String = "E1:N1" 

Set srcRng = Intersect(Me.Range("A1"), Target) 

If Not srcRng Is Nothing Then 

    Set destRng = ThisWorkbook.Sheets(sFoglio\_Destinazione).Range(sDestinazione) 

    Set preRng = ThisWorkbook.Sheets(sFoglio\_Destinazione).Range(sPrelievo) 

    Cancel = True 

    On Error GoTo XIT 

    Application.EnableEvents = False 

    For Each rCell In preRng.Cells 

        With rCell 

            If Not IsEmpty(destRng.Value) Then 

                destRng = .Offset(0, 0).Formula2R1C1 + 1 

            End If 

        End With 

    Next rCell 

End If 

XIT:

Application.EnableEvents = True 

ThisWorkbook.Sheets(sFoglio\_Destinazione).Select 

End Sub

ottenendo il seguente risultato:

mentre dovrebbe essere il seguente:

Vladimiro

Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti Nessun commento
Risposta accettata dall'autore della domanda
Anonimo
2022-01-12T11:53:38+00:00

Ciao Vladimiro,

probabilmente ho saltato un passaggio e cioè:

  1. Mi costruisco un'unica tabella nel foglio1 identica a Tabella1 del tuo primo esempio.
  2. Invece di avere i dati nel foglio2 nell'intervallo di celle B:H, mi potresti modificare il codice postato in precedenza per avere i dati dal foglio2 al foglio1 partendo dalla colonna CV?

Se ho ben capito le modifiche richieste, nel modulo di codice standard, incolla il seguente codice:

'========>>

Option Explicit

Public Const sUltima_Colonna_Sorgente As String = "DB" '<<=== Modifica

'-------->>

Public Sub Aggiorna_Tabella()

Dim SH As Worksheet 

Dim Rng As Range 

Dim oTabella As ListObject 

Dim i As Long, iRows As Long 

Const sTabella As String = **"Tabella1"                                    '&lt;&lt;=== Modifica** 

Const sPrima\_Cella\_Sorgente As String = **"CV6"                    '&lt;&lt;=== Modifica** 

Set SH = ThisWorkbook.Sheets("Foglio1") 

With SH 

 iRows = .Range(sPrima\_Cella\_Sorgente).CurrentRegion.Rows.Count 

  Set oTabella = .ListObjects(sTabella) 

End With 

 With oTabella.DataBodyRange 

    Set Rng = .Rows(1) 

    If .Rows.Count &gt; 1 Then 

        Application.EnableEvents = False 

        .Offset(1, 0).Resize(.Rows.Count - 1).Delete 

        Application.EnableEvents = True 

    End If 

End With 

With Application 

    .DisplayAlerts = False 

    .Calculation = xlCalculationManual 

    Rng.AutoFill Destination:=Rng.Resize(iRows), Type:=xlFillDefault 

    .DisplayAlerts = True 

    .Calculation = xlCalculationAutomatic 

End With 

End Sub

'<<========

Nel modulo di codice del Foglio1, incolla:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range 

Set Rng = Intersect(Me.Columns(sUltima\_Colonna\_Sorgente), Target) 

If Not Rng Is Nothing Then 

    Application.ScreenUpdating = False 

    Call Aggiorna\_Tabella 

    Application.ScreenUpdating = True 

End If 

End Sub

'<<========

Cancella il codice nel modulo di codice del Foglio2.

Potresti scaricare il mio file di prova Vladimiro20220112.xlsm

===

Regards,

Norman

Immagine

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti Nessun commento
Risposta accettata dall'autore della domanda
Anonimo
2022-01-06T20:03:42+00:00

Ciao Vladimiro,

naturalmente va bene.

Un ultima cosa.

E' possibile avere i dati in tabella appena si inseriscono righe nuove senza servirsi di un pulsante che gli dia il comando?

Sostituisci il codice nel modulo standard con la seguente versione:

'========>>

Option Explicit

Public Const sUltima_Colonna_Sorgente As String = "W" '<<=== Modifica

'-------->>

Public Sub Aggiorna_Tabella(oFoglio As Worksheet)

Dim oTabella As ListObject 

Dim i As Long, iRows As Long 

Const sTabella As String = **"Tabella1"                                 '&lt;&lt;=== Modifica** 

Const sPrima\_Cella\_Sorgente As String = **"N4"                  '&lt;&lt;=== Modifica** 

With oFoglio 

    iRows = .Range(sPrima\_Cella\_Sorgente).CurrentRegion.Rows.Count 

    Set oTabella = .ListObjects(sTabella) 

End With 

On Error GoTo XIT:

Application.EnableEvents = False 

With oTabella 

    With .DataBodyRange 

        If .Rows.Count &gt; 1 Then 

            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete 

        End If 

    End With 

    For i = 1 To iRows - 1 

        .ListRows.Add (1 + i) 

    Next i 

End With 

XIT:

Application.EnableEvents = True 

End Sub

'<<========

Nel modulo di codice del foglio di interesse, incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range 

Set Rng = Intersect(Me.Columns(sUltima\_Colonna\_Sorgente), Target) 

If Not Rng Is Nothing Then 

    Application.ScreenUpdating = False 

    Call Aggiorna\_Tabella(Me) 

    Application.ScreenUpdating = True 

End If 

End Sub

'<<========

Ho aggiornato il mio file di prova Vladimiro20220106.xlsm

===

Regards,

Norman

Immagine

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti Nessun commento
Risposta accettata dall'autore della domanda
Anonimo
2022-01-05T14:32:46+00:00

Ciao Vladimiro,

Ciao Norman,

naturalmente funziona.

Vorrei chiederti un'altra cosa, sempre per cercare di imparare.

Poniamo di avere la seguente situazione:

Immagine

Mettiamo che le formule elaborate nell'intervallo di celle E4 : L4 facciano riferimento a un altro intervallo di celle, ad esempio I2 : AF2 e man mano che si passa al rigo successivo E5 : L5 il riferimento sarà I3 : AF3 (e così via).

Domanda:

senza ricostruire nel codice le formule scritte nel primo rigo E4 : L4, c'è la possibilità, facendo doppio click nella cella A1, di avere le stesse formule in E5 : L5 riferite all'intervallo di celle I3 : AF3 (e così via)?

Prova come segue:

  • Inserisci le formule richieste nella prima riga della tabella di output
  • Aggiungi una riga di intestazione adatta
  • Converti la tabella di output in una tabella di Excel (Ctrl + T)

Nel modulo di codice del foglio di interesse, incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim Rng As Range 

Dim oTabella As ListObject 

Const sTabella As String = "Tabella1"        '&lt;&lt;=== Modifica 

Set oTabella = Me.ListObjects(sTabella) 

Cancel = True 

With oTabella.DataBodyRange 

    Set Rng = .Rows(.Rows.Count) 

End With 

With Rng 

    .Copy Destination:=.Offset(1) 

End With 

End Sub

'<<========

Faccendo doppio clic sulla cella A1, ottengo:

Ripetendo il doppio click ottengo:

Potresti scaricare il mio file di prova aggiornata Vladimiro20220105.xlsm

In questo file, il codice si trova nel modulo di codice del foglio Foglio2; il codice precedente si riferisci al Foglio1.

==

Regards,

Norman

Immagine

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti Nessun commento

33 risposte aggiuntive

Ordina per: Più recente
  1. Anonimo
    2022-01-11T17:49:42+00:00

    Il codice può essere rivisto per gestire la situazione anche se si sceglie di non convertire i dati nelle colonne B:H in una tabella di Excel, ma il codice sarà più pulito ed efficiente se riusciamo a sfruttare la caratteristica intrinseca di espansione e contrazione automatica delle tabelle di Excel .

    In sintesi, la scelta è tua!

    ===

    Regards,

    Norman

    Immagine

    Ciao Norman,

    purtroppo è impossibile costruire un'unica tabella in quanto l'altro intervallo dopo il B:H è il AI:CO.

    Facciamo così, siccome ho tutti gli esempi per costruirmi o meno una tabella unica, quello che mi manca è un'altra opzione e cioè:

    ritorniamo alla Tabella1 -> B:Q

    Se volessi sostituire la posizione dei dati dal foglio2 allo stesso foglio1 con dati nell'intervallo CV:DB,

    come si dovrebbe modificare il seguente codice?

    '========>>

    Option Explicit

    Public Const sUltima_Colonna_Sorgente As String = "H" '<<=== Modifica

    '-------->>

    Public Sub Aggiorna_Tabella()

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim Rng As Range

    Dim oTabella As ListObject

    Dim i As Long, iRows As Long

    Const sTabella As String = "Tabella1" '<<=== Modifica

    Const sPrima_Cella_Sorgente As String = "B6" '<<=== Modifica

    With ThisWorkbook

    Set srcSH = .Sheets("Foglio2")

    Set destSH = .Sheets("Foglio1")

    End With

    iRows = srcSH.Range(sPrima_Cella_Sorgente).CurrentRegion.Rows.Count

    Set oTabella = destSH.ListObjects(sTabella)

    With oTabella.DataBodyRange

    Set Rng = .Rows(1)

    If .Rows.Count > 1 Then

    .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete

    End If

    End With

    Application.DisplayAlerts = False

    Rng.AutoFill Destination:=Rng.Resize(iRows), Type:=xlFillDefault

    Application.DisplayAlerts = True

    End Sub

    '<<========

    '========>>

    Option Explicit

    '-------->>

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Rng As Range

    Set Rng = Intersect(Me.Columns(sUltima_Colonna_Sorgente), Target)

    If Not Rng Is Nothing Then

    Application.ScreenUpdating = False

    Call Aggiorna_Tabella

    Application.ScreenUpdating = True

    End If

    End Sub

    '<<========

    Vladimiro

    Ciao Norman,

    probabilmente ho saltato un passaggio e cioè:

    1. Mi costruisco un'unica tabella nel foglio1 identica a Tabella1 del tuo primo esempio.
    2. Invece di avere i dati nel foglio2 nell'intervallo di celle B:H, mi potresti modificare il codice postato in precedenza per avere i dati dal foglio2 al foglio1 partendo dalla colonna CV?

    Vladimiro

    La risposta è stata utile?

    0 commenti Nessun commento
  2. Anonimo
    2022-01-11T11:23:42+00:00

    Il codice può essere rivisto per gestire la situazione anche se si sceglie di non convertire i dati nelle colonne B:H in una tabella di Excel, ma il codice sarà più pulito ed efficiente se riusciamo a sfruttare la caratteristica intrinseca di espansione e contrazione automatica delle tabelle di Excel .

    In sintesi, la scelta è tua!

    ===

    Regards,

    Norman

    Immagine

    Ciao Norman,

    purtroppo è impossibile costruire un'unica tabella in quanto l'altro intervallo dopo il B:H è il AI:CO.

    Facciamo così, siccome ho tutti gli esempi per costruirmi o meno una tabella unica, quello che mi manca è un'altra opzione e cioè:

    ritorniamo alla Tabella1 -> B:Q

    Se volessi sostituire la posizione dei dati dal foglio2 allo stesso foglio1 con dati nell'intervallo CV:DB,

    come si dovrebbe modificare il seguente codice?

    '========>>

    Option Explicit

    Public Const sUltima_Colonna_Sorgente As String = "H" '<<=== Modifica

    '-------->>

    Public Sub Aggiorna_Tabella()

    Dim srcSH As Worksheet, destSH As Worksheet 
    
    Dim Rng As Range 
    
    Dim oTabella As ListObject 
    
    Dim i As Long, iRows As Long 
    
    Const sTabella As String = "Tabella1"                     '&lt;&lt;=== Modifica 
    
    Const sPrima\_Cella\_Sorgente As String = "B6"              '&lt;&lt;=== Modifica 
    
    With ThisWorkbook 
    
        Set srcSH = .Sheets("Foglio2") 
    
        Set destSH = .Sheets("Foglio1") 
    
    End With 
    
    iRows = srcSH.Range(sPrima\_Cella\_Sorgente).CurrentRegion.Rows.Count 
    
    Set oTabella = destSH.ListObjects(sTabella) 
    
    With oTabella.DataBodyRange 
    
        Set Rng = .Rows(1) 
    
        If .Rows.Count &gt; 1 Then 
    
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete 
    
        End If 
    
    End With 
    
    Application.DisplayAlerts = False 
    
    Rng.AutoFill Destination:=Rng.Resize(iRows), Type:=xlFillDefault 
    
    Application.DisplayAlerts = True 
    

    End Sub

    '<<========

    '========>>

    Option Explicit

    '-------->>

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Rng As Range 
    
    Set Rng = Intersect(Me.Columns(sUltima\_Colonna\_Sorgente), Target) 
    
    If Not Rng Is Nothing Then 
    
        Application.ScreenUpdating = False 
    
        Call Aggiorna\_Tabella 
    
        Application.ScreenUpdating = True 
    
    End If 
    

    End Sub

    '<<========

    Vladimiro

    La risposta è stata utile?

    0 commenti Nessun commento