Inserire valori fissi tramite macro.

Question

Salve,

ho la seguente situazione:

Siccome nella colonna B ci sono valori che cambiano in continuazione, mi serve l'archivio storico, da riportare nella colonna A, del primo valore che esce nel momento in cui inserisco dei nuovi valori nell'intervallo D:F.

Ad esempio, se nella cella B24 il valore 1 passa ad un altro valore, il valore 1 già presente nella cella adiacente della colonna A non deve cambiare.

Mi dite come costruire la macro?

Vladimiro

Answer 1

Ciao Vladimiro,

Ciao Norman,

Ho alcune ulteriori domande:

• I valori in ogni riga dell'intervallo C23:F27 sono inseriti manualmente o sono il risultato di formule ? Sono inseriti manualmente
• Nel primo caso, i valori vengono inseriti in sequenza nelle celle della riga o i dati vengono copiati nella riga in un'unica operazione di copia ? Vengono inseriti in sequenza.
• Con riferimento al secondo scenario, se la riga da cui partire fosse (ad esempio) la riga 28 con un nuovo inserimento nell'intervallo di celle C28 : F28, ho ragione nel ritenere che l'intervallo B23:B27 debba essere copiato nell'intervallo A23: A27? Esatto.

Un ulteriore domanda.

Siccome c'è la possibilità di avere anche valore nullo nelle celle della colonna B, naturalmente dopo aver inserito i dati nell'intervallo C : F della riga corrispondente, crea qualche problema nella macro?

Esempio:

Come puoi vedere, nella riga 28, dopo aver inserito i dati nell'intervallo di celle C28 : F28, il valore della cella B28 è nullo e di conseguenza, con la macro, dovrebbe essere nullo anche il valore della cella A28 rimanendo nullo anche nei futuri inserimenti:

A condizione di aver compreso appieno, nel caso del primo scenario, nel modulo di codice del foglio di interesse prova:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Rng2 As Range, RngA As Range, RngB As Range, rRow As Range 

Const sIntervallo As String = "D:F"  'D23:F27" 

Const iPrimaRiga As Long = 23 

With Me.Range(sIntervallo) 

    Set Rng = .Columns(.Columns.Count) 

    Set Rng = Rng.Resize(Me.UsedRange.Rows.Count - iPrimaRiga + 1).Offset(iPrimaRiga - 1) 

End With 

Set Rng2 = Intersect(Rng, Target) 

If Not Rng2 Is Nothing Then 

    On Error GoTo XIT 

    Application.EnableEvents = False 

    For Each rRow In Rng2.Cells 

        With rRow 

            Set RngA = Intersect(.EntireRow, Me.Columns("A")) 

            Set RngB = Intersect(.EntireRow, Me.Columns("B")) 

            If IsEmpty(RngA) Then 

                RngA.Value = RngB.Value 

            End If 

        End With 

    Next rRow 

End If 

XIT:

Application.EnableEvents = True 

End Sub

'<<========

Nel caso del secondo scenario, prova qualcosa del genere:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Rng2 As Range, Rng3 As Range 

Dim RngA As Range, RngB As Range, rRow As Range 

Dim bFlag As Boolean 

Const sIntervallo As String = "D:F" 

Const iPrimaRiga As Long = 23 

Const iRiga\_da\_Partire As Long = 28 

With Me.Range(sIntervallo) 

    Set Rng = .Columns(.Columns.Count) 

    Set Rng = Rng.Resize(Me.UsedRange.Rows.Count - iPrimaRiga + 1).Offset(iPrimaRiga - 1) 

End With      

Set Rng2 = Intersect(Rng, Target)      

If Not Rng2 Is Nothing Then 

    bFlag = Rng2.Row = iRiga\_da\_Partire 

    On Error GoTo XIT 

    Application.EnableEvents = False 

    If bFlag Then 

        Set Rng3 = Intersect(Rng.Resize(iRiga\_da\_Partire - iPrimaRiga).EntireRow, Me.Columns("B")) 

        Rng3.Offset(0, -1).Value = Rng3.Value 

    End If 

    For Each rRow In Rng2.Cells 

        With rRow 

            Set RngA = Intersect(.EntireRow, Me.Columns("A")) 

            Set RngB = Intersect(.EntireRow, Me.Columns("B")) 

            If IsEmpty(RngA) Then 

                RngA.Value = RngB.Value 

            End If 

        End With 

    Next rRow 

End If 

XIT:

Application.EnableEvents = True 

End Sub

'<<========

Potresti scaricare il mio file di prova Vladimiro20210609.xlsm

===

Regards,

Norman

Answer 2

[...]

Detto questo, se il tuo foglio contiene migliaia di formule che rallentano le prestazioni del file, ti suggerirei di prendere in considerazione l'utilizzo del codice evento Worksheet_Change per inserire il risultato della formula per sostituire le formule.

[...]

A titolo di esempio, per evitare l'uso delle formule nel primo foglio del mio file di prova, si potrebbe modificare il codice suggerito con qualcosa del genere:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Rng2 As Range, RngA As Range, RngB As Range, rRow As Range 

Const sIntervallo As String = "D:F"  'D23:F27" 

Const iPrimaRiga As Long = 23 

With Me.Range(sIntervallo) 

    Set Rng = .Columns(.Columns.Count) 

    Set Rng = Rng.Resize(Me.UsedRange.Rows.Count - iPrimaRiga + 1).Offset(iPrimaRiga - 1) 

End With 

Set Rng2 = Intersect(Rng, Target) 

If Not Rng2 Is Nothing Then 

    On Error GoTo XIT 

    Application.EnableEvents = False 

    For Each rRow In Rng2.Cells 

        With rRow 

            Set RngA = Intersect(.EntireRow, Me.Columns("A")) 

            Set RngB = Intersect(.EntireRow, Me.Columns("B")) 

            **RngB.Value = Application.Evaluate("=INT(AVERAGE(D" & rRow.Row & ":F" & rRow.Row & "))")** 

            If IsEmpty(RngA) Then 

                RngA.Value = RngB.Value 

            End If 

        End With 

    Next rRow 

End If 

XIT:

Application.EnableEvents = True 

End Sub

'<<========

===

Regards,

Norman

Answer 3

Ciao Vladimiro,

Ciao Norman,

aspetta!!!!!!! :-)

Ho notato nel codice una bella cosa che non pensavo si potesse fare e cioè avere man mano che inserisco i dati il codice scritto della cella precedente:

=INT(MEDIA(D28:F28))

che diventa:

=INT(MEDIA(D29:F29))

Siccome in un intervallo di celle ho un codice, tra l'altro che mi hai suggerito tu, che mi rallenta parecchio l'esecuzione in quanto è stato messo su migliaia di righe, si potrebbe fare la stessa cosa partendo ad esempio dalla riga 25?

H25 : DF25 e DH25 : HC25

Se converti i tuoi dati in una tabella Excel, tutte le formule verranno inserite automaticamente quando una nuova riga di dati viene aggiunta alla tabella..

Detto questo, se il tuo foglio contiene migliaia di formule che rallentano le prestazioni del file, ti suggerirei di prendere in considerazione l'utilizzo del codice evento Worksheet_Change per inserire il risultato della formula per sostituire le formule.

Se ti interessa caricare il file reale, ti suggerirò volentieri il codice apposito. Se preferisci non caricare il file su un forum pubblico, puoi inviarmi il file in privato. In tal caso troverai un indirizzo email decifrabile cliccando sul mio profilo.

===

Regards,

Norman

Answer 4

Ciao Vladimiro,

Ciao Norman,

hai capito benissimo!!!

Grazie e alla prossima,

Ti ringrazio per il cortese riscontro.

Alla prossim.

===

Regards,

Norman

Ciao Norman,

aspetta!!!!!!! :-)

Ho notato nel codice una bella cosa che non pensavo si potesse fare e cioè avere man mano che inserisco i dati il codice scritto della cella precedente:

=INT(MEDIA(D28:F28))

che diventa:

=INT(MEDIA(D29:F29))

Siccome in un intervallo di celle ho un codice, tra l'altro che mi hai suggerito tu, che mi rallenta parecchio l'esecuzione in quanto è stato messo su migliaia di righe, si potrebbe fare la stessa cosa partendo ad esempio dalla riga 25?

H25 : DF25 e DH25 : HC25

Vladimiro

Answer 5

Ciao Vladimiro,

Ciao Norman,

hai capito benissimo!!!

Grazie e alla prossima,

Ti ringrazio per il cortese riscontro.

Alla prossim.

===

Regards,

Norman