| | Post: 70 | Registrato il: 08/12/2013
| Utente Junior | Excel 2010 | | OFFLINE | |
|
  29/04/2018 17:21 | |
Ciao a tutti.
In alcune celle di una tabella devo inserire direttamente il valore calcolato da una data formula scritta nel codice vba se sono rispettate alcune condizioni. Il codice che allego inserisce la formula ma non il valore calcolato dalla stessa. Inoltre, l'operazione viene calcolata nella riga 8 e in quelle sottostanti. Ecco la macro da modificare:
Sub Calcola_Prodotto()
Range("J8").Select
ActiveCell.FormulaR1C1 = _ "=IF(AND(RC2=""F"",RC7<>0,RC8<>0),ROUND(RC7*RC8,2),"""")"
Range("K8").Select
ActiveCell.FormulaR1C1 = _ "=IF(RC9=""N"",0,IF(AND(RC7<>0,RC8<>0),ROUND(RC10*RC9/100,2),""""))"
End Sub
Grazie, per l'aiuto che potrete darmi. [Modificato da franco28.2013 29/04/2018 17:33] |
|
| | Post: 2.853 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 29/04/2018 19:19 | |
Buona sera, Franco; prima di passare a VBA consiglio di rivedere le Formule. Almeno: =SE(E($B8="F";$G8<>0;$H8<>0);ARROTONDA($G8*$H8;2);"") Fatto ciò si potrebbe pensare a: inserita in un Evento: Private Sub Worksheet_Change(ByVal Target As Range) A disposizione. Buon fine settimana. Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 70 | Registrato il: 08/12/2013
| Utente Junior | Excel 2010 | | OFFLINE | |
|
| 30/04/2018 00:32 | |
Ciao, Giuseppe.
Avevo pensato anch'io a queste due funzioni
.FormulaLocal
Private Sub Worksheet_Change(ByVal Target As Range)
Ho provato a inserirle nella macro ma non sono riuscito a farla funzionare. Non sono pratico in vba.
Allego il file, sperando in un aiuto.
Grazie per la disponibilità.
Buonanotte.
Franco
|
| | Post: 2.854 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 30/04/2018 07:26 | |
Buona giornata, Franco;
il File che hai allegato chiarisce molti dubbi.
Consentimi di precisare che l'istruzione:
ur = Range("A" & Rows.Count).End(xlUp).Row applicata ad una "Tabella" falsa il risultato; nel nostro caso propone "ur = 17" che è l'ultima riga della Tabella.
Il risultato corretto lo puoi ottenere con:
Dim ur As Long
ur = 8
Do While Cells(ur, 1) <> ""
ur = ur + 1
Loop
ur = ur - 1
nel nostro caso propone "ur = 13" che è l'ultima riga valida della Tabella.
Per ottenere il valore assoluto calcolato dalle Formule potresti pensare ad un Codice VBA di questo genere:
Option Explicit
Sub Test()
Dim ur As Long
ur = 8
Do While Cells(ur, 1) <> ""
ur = ur + 1
Loop
ur = ur - 1
Range(Cells(8, 10), Cells(ur, 11)).Copy
Cells(8, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Rimangono inalterate le Formule presenti nel Range:
- J14:K17
e quelle dei Range:
- L8:L17
e
- Q8:Q17
In alternativa si potrebbe pensare ad una Tabella senza Formule con Valori calcolati direttamente nell'evento:
- Private Sub Worksheet_Change
È un lavoro piuttosto impegnativo ma si potrebbe fare.
A disposizione.
Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 71 | Registrato il: 08/12/2013
| Utente Junior | Excel 2010 | | OFFLINE | |
|
| 30/04/2018 10:07 | |
Buongiorno, Giuseppe.
Ho modificato le istruzioni vba secondo le tue indicazioni.
Non so se ho inserito le istruzioni nei punti giusti.
Come potrai notare, nelle righe vuote da 14 a fine tabella vengono inserite in K e J le formule previste solamente nel caso siano rispettate le condizioni stabilite nelle formule stesse. Invece, le celle in K e J dalla riga 14 fino a fine tabella dovrebbero essere vuote.
L'ideale sarebbe una tabella senza formule, ma non sono in grado di farlo. Sarei molto grato, comunque, se qualcuno lo facesse.
Grazie e buona giornata.
Franco |
| | Post: 2.855 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 30/04/2018 11:52 | |
Buona giornata, Franco; purtroppo questa settimana non potrò dedicarmi al tuo File ma la prossima settimana vedrò quello che riesco a proporti in ogni caso vedrai che molto probabilmente Utenti molto più Esperti potranno proporti soluzioni interessanti. A disposizione. Buon I° Maggio. Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 2.857 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 30/04/2018 19:12 | |
Buona sera, Franco;
mi sono ritagliato giusto il tempo per abbozzare una proposta.
Ti chiedo la Cortesia di provare questo Codice VBA che, per il momento, non è legato all'Evento "Private Sub Worksheet_Change"; quindi va attivato manualmente o, per comodità, con un Pulsante.
Devi semplicemente posizionarti su una Cella del Record che desideri valutare e lanciare il Codice VBA.
Option Explicit
Sub Copia_Formule()
Application.ScreenUpdating = False
Cells(ActiveCell.Row, 10).FormulaLocal = "=SE(E($B" & ActiveCell.Row & "=" & """F""" & ";$G" & ActiveCell.Row & "<>0;$H" & ActiveCell.Row & "<>0);ARROTONDA($G" & ActiveCell.Row & "*$H" & ActiveCell.Row & ";2);"""")"
Cells(ActiveCell.Row, 11).FormulaLocal = "=SE($I" & ActiveCell.Row & "=" & """N""" & ";0;SE(E($G" & ActiveCell.Row & "<>0;$H" & ActiveCell.Row & "<>0);ARROTONDA($J" & ActiveCell.Row & "*$I" & ActiveCell.Row & "/100;2);""""))"
Cells(ActiveCell.Row, 12).FormulaLocal = "=SE($E" & ActiveCell.Row & "=""" & """;"""";SOMMA($J" & ActiveCell.Row & ":$K" & ActiveCell.Row & "))"
Cells(ActiveCell.Row, 17).FormulaLocal = "=SE($E" & ActiveCell.Row & "=""" & """;"""";SOMMA($O" & ActiveCell.Row & ":$P" & ActiveCell.Row & "))"
Range(Cells(ActiveCell.Row, 10), Cells(ActiveCell.Row, 12)).Copy
Cells(ActiveCell.Row, 10).PasteSpecial Paste:=xlPasteValues
Cells(ActiveCell.Row, 17).Copy
Cells(ActiveCell.Row, 17).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Cells(ActiveCell.Row + 1, 1).Select
End Sub
Nella Tabella non troverai più Formule ma solo i risultati delle Formule originali.
Nel caso la Procedura sia di tuo interesse è possibile legarla ad un Evento.
A disposizione.
Buona serata.
Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 72 | Registrato il: 08/12/2013
| Utente Junior | Excel 2010 | | OFFLINE | |
|
| 01/05/2018 08:56 | |
Buongiorno,Giuseppe.
Buon 1° maggio.
Grazie per l'impegno e il buon risultato.
Ho inserito la nuova procedura proposta eliminando quella originaria Sub Calcola_Prodotto (celle J e K) e le formule dei totali presenti nelle celle L e Q. Ho eliminato anche il codice vba Sub Test (non so se ho fatto bene).
La nuova procedura è quella giusta, anche se l'esecuzione è poco dinamica. Come dicevi fin dall'inizio della discussione, è indispensabile legarla a un evento del tipo Private Sub Worksheet_Change(ByVal Target As Range).
Ho notato però che l'attuale procedura di calcolo delle formule viene eseguita anche oltre la riga contenente dati e, addirittura, oltre la fine della tabella. Invece dovrebbe arrestarsi alla riga contenente i dati. Inoltre, le celle contenenti i valori delle formule presentano il fastidioso triangolino verde di errore.
Buona giornata.
Franco |
| | Post: 2.858 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 01/05/2018 09:38 | |
Buona giornata, Franco;
per il "triangolino verde" dovrebbe essere presente solo se esistono delle Formule e nel File con il quale ho condotto i miei Test non compare.
Per evitare l'elaborazione delle celle che superano quelle contenente i Dati potresti provare a modificare il Codice VBA in questo modo molto essenziale:
Option Explicit
Sub Copia_Formule()
Application.ScreenUpdating = False
Dim Ur As Long
Ur = 8
Do While Cells(Ur, 1) <> ""
Ur = Ur + 1
Loop
Ur = Ur - 1
If ActiveCell.Row > Ur Then End
Cells(ActiveCell.Row, 10).FormulaLocal = "=SE(E($B" & ActiveCell.Row & "=" & """F""" & ";$G" & ActiveCell.Row & "<>0;$H" & ActiveCell.Row & "<>0);ARROTONDA($G" & ActiveCell.Row & "*$H" & ActiveCell.Row & ";2);"""")"
Cells(ActiveCell.Row, 11).FormulaLocal = "=SE($I" & ActiveCell.Row & "=" & """N""" & ";0;SE(E($G" & ActiveCell.Row & "<>0;$H" & ActiveCell.Row & "<>0);ARROTONDA($J" & ActiveCell.Row & "*$I" & ActiveCell.Row & "/100;2);""""))"
Cells(ActiveCell.Row, 12).FormulaLocal = "=SE($E" & ActiveCell.Row & "=""" & """;"""";SOMMA($J" & ActiveCell.Row & ":$K" & ActiveCell.Row & "))"
Cells(ActiveCell.Row, 17).FormulaLocal = "=SE($E" & ActiveCell.Row & "=""" & """;"""";SOMMA($O" & ActiveCell.Row & ":$P" & ActiveCell.Row & "))"
Range(Cells(ActiveCell.Row, 10), Cells(ActiveCell.Row, 12)).Copy
Cells(ActiveCell.Row, 10).PasteSpecial Paste:=xlPasteValues
Cells(ActiveCell.Row, 17).Copy
Cells(ActiveCell.Row, 17).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Cells(ActiveCell.Row + 1, 1).Select
End Sub
Il Codice VBA viene eseguito solo se in Colonna "A" è stato preventivamente inserito un Valore ma è possibile legare la condizione alla presenza di un Valore anche in altra Colonna.
Il Codice può essere reso più personalizzato aggiungendo un "MsgBox" nella Condizione "If ActiveCell.Row > Ur" che avverte l'Utente che il Record selezionato non contiene alcun Valore in Colonna "A"; ovviamente, vedi tu.
A disposizione.
Buona serata.
Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 73 | Registrato il: 08/12/2013
| Utente Junior | Excel 2010 | | OFFLINE | |
|
| 01/05/2018 14:43 | |
Buongiorno, Giuseppe.
Ho modificato l'istruzione del codice vba secondo le tue indicazioni. Purtroppo gli eventi descritti nel precedente mio post rimangono.
Ecco come eseguo il codice:
- apro la tabella, cancello i dati delle formule presenti nelle colonne J, K, L e Q, mi posiziono su una cella della tabella (ad esempio sulla cella L10);
- apro l'editor del vba con ALT+F11 e premo il tasto esegui;
In questo caso, le predette colonne si riempiono dei valori delle formule e quando mi posiziono su ogni cella (con o senza valore) delle stesse colonne si visualizzano le formule. Le uniche celle in cui compaiono i valori senza le formule sono quelle della riga 10 dove mi ero posizionato inizialmente. Le formule compaiono anche nelle righe dove non ci sono dati fino all'ultima riga della tabella.
Sbaglio forse la procedura di attivazione della macro?
Allego il file di prova.
Buongiorno.
Franco |
| | Post: 2.859 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 01/05/2018 16:25 | |
Buon pomeriggio, Franco; quello che lamenti è una caratteristica della struttura "Tabella". Personalmente preferisco evitare la struttura "Tabella". Prova a trasformare la "Tabella" in "Intervallo di dati"; per maggiori informazioni prova a dare uno sguardo a: QuiA disposizione. Buona serata. Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 74 | Registrato il: 08/12/2013
| Utente Junior | Excel 2010 | | OFFLINE | |
|
| 01/05/2018 18:01 | |
Buonasera, Giuseppe.
In effetti eliminando la tabella excel i problemi prima evidenziati sono scomparsi.
Per poter eseguire il codice Sub Copia_Formule, senza aprire l'editor del vba con ALT+F11 e premere poi il tasto esegui, ho inserito un comodo pulsante al quale ho assegnato la macro.
Ho notato però i seguenti problemi:
- non c'è più la visualizzazione delle righe con colori alternati della tabella excel;
- se per caso è selezionata una cella posta sopra l'intervallo dati A7:R16, premendo il pulsante, vengono cancellati tutti i dati posti nelle celle situate nelle colonne delle formule (J, K, L e Q) dalla riga 1 alla riga 7; non succede nulla se la cella selezionata si trova al di sotto dell'ultima riga compilata;
- c'è un'operazione in cui se cella B="F" e cella F="R2018" (cioè "R"+anno), non ci sono dati da inserire nelle corrispondenti celle G, H e I; in questo caso è l'utente (e non la macro) che deve inserire direttamente i valori nelle corrispondenti celle J e K.
Grazie, per la disponibilità.
Buona serata.
Franco |
| | Post: 2.860 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 01/05/2018 18:46 | |
Buona sera, Franco. Per la "Lettura facilitata" (visualizzazione delle righe con colori alternati della tabella excel) devi intervenire con la Funzione "Formattazione condizionale". Per gli altri problemi devi porre le condizioni nel Codice VBA; esempio: If ActiveCell.Row > Ur Or ActiveCell.Row < 8 Then End Analogamente per tutte le altre condizioni. Buona serata. Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
|
|
|
|