Applicare formula R1C1

Anonimo

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

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

Risposta accettata dall'autore della domanda

Anonimo

Ciao Vladimiro,

probabilmente ho saltato un passaggio e cioè:

Mi costruisco un'unica tabella nel foglio1 identica a Tabella1 del tuo primo esempio.

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

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

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

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Vladimiro,

Ciao Norman,

naturalmente funziona.

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

Poniamo di avere la seguente situazione:

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

0 commenti

33 risposte aggiuntive

Anonimo

2022-01-05T08:18:43+00:00

Ciao Norman,

naturalmente funziona.

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

Poniamo di avere la seguente situazione:

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)?

Vladimiro
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2022-01-05T05:16:59+00:00
Ciao Vladimiro,

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:

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

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
```
Dim destSH As Worksheet 

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

Dim rFirstRow As Range 

Dim sFormula As String 

Dim iAumenta As Long, i As Long 

Dim LRow As Long 

Const sFoglio\_Destinazione As String = "**Foglio1"          '&lt;&lt;=== Modifica** 

Const sColonne\_Destinazione As String = **"C:L"** 

Const iPrima\_Riga\_Destinazione As Long = **6** 

Const sPrelievo As String = **"E1:N1"** 

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

If Not srcRng Is Nothing Then 

    Cancel = True 

    Set destSH = ThisWorkbook.Sheets(sFoglio\_Destinazione) 

    With destSH 

        Set rFirstRow = Intersect(.Range(sColonne\_Destinazione), .Rows(iPrima\_Riga\_Destinazione)) 

        LRow = LastRow(destSH, .Columns(sColonne\_Destinazione), iPrima\_Riga\_Destinazione) 

        Set destRng = Intersect(.Range(sColonne\_Destinazione), .Rows(LRow - Not IsEmpty(rFirstRow.Cells(1).Value))) 

        Set preRng = .Range(sPrelievo) 

    End With 

    iAumenta = destRng.Row - iPrima\_Riga\_Destinazione 

    On Error GoTo XIT 

    Application.EnableEvents = False 

    For Each rCell In preRng.Cells 

        i = i + 1 

        With rCell 

            sFormula = .Formula2 & "+" & iAumenta 

            destRng.Cells(i).Formula2 = sFormula 

        End With 

    Next rCell 

End If 
```
XIT:
```
Application.EnableEvents = True 

ThisWorkbook.Sheets(sFoglio\_Destinazione).Select 
```
End Sub

'<<========

Nota che se il foglio di origine e il foglio di destinazione sono lo stesso foglio, come mostrato nel tuo screenshot, questo codice può essere abbreviato.

Potresti scaricare il mio file di prova Vladimiro20220105.xlsm

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento