macro in vba con ricerca di valori e risultati diversi

Anonimo
2022-12-08T13:04:22+00:00

Ciao a tutti,

ho studiato visual basic tanti anni fa e adesso ricordo ben poco del linguaggio..

Vorrei creare in excell una macro con diversi SE..

La formula originaria sarebbe:

e1= SE (a1= "runner"; 5- c2; SE ( a1= "tovaglia"; 3- c2; SE ( a1= "strofinaccio"; 10 - c2 )))

questa stessa formula la devo effettuare poi in tutta la colonna E, prendendo in considerazione i valori della riga corrispondente.

Come posso fare?

grazie a chi risponderà

Microsoft 365 e Office | Excel | Per il lavoro | Android

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
Gianfranco55 25,270 Punti di reputazione Moderatore volontario
2022-12-08T20:20:25+00:00

ciao

Norman

non ti arrabbiare ma cosa ne dici di questa

https://www.dropbox.com/s/2nho91mqa4zrmxg/select%20case.xlsm?dl=0

Option Explicit 

Option Compare Text 

 Sub Ccalcola() 

Dim lista As Range 

Dim cl As Range 

   Set lista = Range(Cells(1, 1), Cells(1, 1).End(xlDown)) 

For Each cl In lista 

    Select Case cl 

Case "Davide" 

   cl.Offset(0, 4) = 3 - cl.Offset(1, 2).Value 

Case "Pluto" 

   cl.Offset(0, 4) = 5 - cl.Offset(1, 2).Value 

Case "Elio" 

   cl.Offset(0, 4) = 10 - cl.Offset(1, 2).Value 

Case "Strofinaccio" 

   cl.Offset(0, 4) = 13 - cl.Offset(1, 2).Value 

Case "pincopallo" 

   cl.Offset(0, 4) = 15 - cl.Offset(1, 2).Value 

End Select 

Next 

End Sub

poi basta aggiungere

Case "pincopallo"

cl.Offset(0, 4) = 15 - cl.Offset(1, 2).Value

con i nomi e la cifra da utilizzare per la sottrazione

ho usato il tuo file e il tuo pulsante😀 sono uno sfaticato

sempliciotto come codice ma funziona

La risposta è stata utile?

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

8 risposte aggiuntive

Ordina per: Più utili
  1. Anonimo
    2022-12-08T15:54:41+00:00

    In realtà così mi da errore nella prima parte quando scrivi rng.formula2r1c1

    La risposta è stata utile?

    0 commenti Nessun commento
  2. Anonimo
    2022-12-08T15:29:58+00:00

    Ciao Desirée,

    In realtà le condizioni sono più di quelle che ho scritto..

    E vorrei usare questa procedura per dei colleghi che non sanno usare excel. In questo modo, premendo un tasto hanno la possibilità di completare il file senza il mio aiuto

    Se la tua intenzione fosse quella di semplificare la formula che i tuoi utenti dovevano immettere, potresti sfruttare la seguente UDF (funzione utente):

    • Alt+F11 per aprire l'editor di VBA
    • Alt+IM per inserire un nuovo modulo di codice
    • Nel nuovo modulo vuoto, incolla il seguente codice:

    '========>>

    Option Explicit

    '-------->>

    Public Function Mio_Se(rCella As Range) As Variant

    Dim Rng As Range, rCell As Range 
    
    Dim arrSottratti As Variant, arrParoli As Variant 
    
    Dim Res As Variant, Res2 As Variant 
    
    Const sParoli As String = \_ 
    
      **"Angelo,Benjamino,tovaglia,Claudia,runner,Davide,Elio,Frederica,Giorgio,strofinaccio"      '<<=== Modifica** 
    
    Const sValori\_Sottratti As String = **"1,2,3,4,5,6,7,8,9,10"                                                                '<<=== Modifica** 
    
    Const dValore\_Iniziale As Double = **10                                                                                             '<<=== Modifica** 
    
    Application.Volatile 
    
    arrParoli = Split(sParoli, ",") 
    
    arrSottratti = Split(sValori\_Sottratti, ",") 
    
    With rCella 
    
        Res = Application.Match(.Value, arrParoli, 0) 
    
        If Not IsError(Res) Then 
    
            Mio\_Se = CDbl(arrSottratti(Res - 1)) - rCella.Offset(1, 2).Value 
    
        Else 
    
            Mio\_Se = vbNullString 
    
        End If 
    
    End With 
    

    End Function

    '<<========

    • Alt+Q per chiudere l'editor di VBA e tornare a Excel.
    • Salva il file con l'estensione xlsm

    Se, tuttavia, desideri che queste formule semplificate vengano inserite automaticamente in risposta al clic su un pulsante, prova come segue:

    • Alt+F11 per aprire l'editor di VBA
    • Alt+IM per inserire un nuovo modulo di codice
    • Nel nuovo modulo vuoto, incolla il seguente codice:

    '========>>

    Option Explicit

    Public Sub Tester()

    Dim Rng As Range, rCell As Range 
    
    Dim Res As Variant 
    
    On Error Resume Next 
    
    Set Rng = Application.InputBox(Prompt:="Seleziona l'intervallo da compilare con formula", Title:="INTERVALLO FORMULE", Type:=8) 
    
    On Error GoTo 0 
    
    On Error Resume Next 
    
    Set Rng = Application.InputBox(Prompt:="Seleziona l'intervallo da compilare con formula", Title:="INTERVALLO FORMULE", Type:=8) 
    
    On Error GoTo 0 
    
    If Not Rng Is Nothing Then 
    
        Rng.Formula2R1C1 = "=Mio\_Se(RC[-4])" 
    
    Else 
    
        Call MsgBox(Prompt:="Non hai selezionato l'intervallo da riempire!", \_ 
    
            Buttons:=vbCritical, \_ 
    
            Title:="PROBLEMA!") 
    
    End If 
    

    End Sub

    '-------->>

    Public Function Mio_Se(rCella As Range) As Variant

    Dim Rng As Range, rCell As Range 
    
    Dim arrSottratti As Variant, arrParoli As Variant 
    
    Dim Res As Variant, Res2 As Variant 
    
    Const sParoli As String = \_ 
    
      **"Angelo,Benjamino,tovaglia,Claudia,runner,Davide,Elio,Frederica,Giorgio,strofinaccio"      '&lt;&lt;=== Modifica** 
    
    Const sValori\_Sottratti As String = **"1,2,3,4,5,6,7,8,9,10"                                                                '&lt;&lt;=== Modifica** 
    
    Const dValore\_Iniziale As Double = **10                                                                                             '&lt;&lt;=== Modifica** 
    
    Application.Volatile 
    
    arrParoli = Split(sParoli, ",") 
    
    arrSottratti = Split(sValori\_Sottratti, ",") 
    
    With rCella 
    
        Res = Application.Match(.Value, arrParoli, 0) 
    
        If Not IsError(Res) Then 
    
            Mio\_Se = CDbl(arrSottratti(Res - 1)) - rCella.Offset(1, 2).Value 
    
        Else 
    
            Mio\_Se = vbNullString 
    
        End If 
    
    End With 
    

    End Function

    '<<========

    • Assegna la procedura Tester al pulsante
    • Alt+Q per chiudere l'editor di VBA e tornare a Excel.
    • Salva il file con l'estensione xlsm

    Potresti scaricare il mio file di prova Desiree20221208.xlsm

    A causa di un problema con l'attuale editor del forum, che inserisce righe vuote indesiderate nel codice copiato dal forum, suggerirei di copiare il mio codice direttamente dal mio file di prova.

    ===

    Regards,

    Norman

    Immagine

    La risposta è stata utile?

    0 commenti Nessun commento
  3. Anonimo
    2022-12-08T13:39:12+00:00

    In realtà le condizioni sono più di quelle che ho scritto..

    E vorrei usare questa procedura per dei colleghi che non sanno usare excel. In questo modo, premendo un tasto hanno la possibilità di completare il file senza il mio aiuto

    La risposta è stata utile?

    0 commenti Nessun commento
  4. Anonimo
    2022-12-08T13:29:57+00:00

    Ciao Desirée,

    ho studiato visual basic tanti anni fa e adesso ricordo ben poco del linguaggio..

    Vorrei creare in excell una macro con diversi SE..

    La formula originaria sarebbe:

    e1= SE (a1= "runner"; 5- c2; SE ( a1= "tovaglia"; 3- c2; SE ( a1= "strofinaccio"; 10 - c2 )))

    questa stessa formula la devo effettuare poi in tutta la colonna E, prendendo in considerazione i valori della riga corrispondente.

    Come posso fare?

    Non mi è chiaro perché hai bisogno di una macro. Più in particolare, perché una formula, trascinata verso il basso, non dovrebbe fornire i risultati richiesti?

    A proposito, penso che la tua formula dovrebbe essere:

     =SE(A1="runner";5-C2;SE(A1="Tovaglia";3-C2;SE(A1="strofinaccio";10-C2**;""**)))
    

    ===

    Regards,

    Norman

    Immagine

    La risposta è stata utile?

    0 commenti Nessun commento