Trasformare la formula SE.ERRORE in una istruzione VBA.

[mflautoPartecipante mflauto Karma: 1 pt]

Buonasera,

 è possibile trasformare questa formula di Excel in una istruzione VBA?

=SE.ERRORE(CERCA.VERT(C15;DB!$B$2:$C$300;2;0);"")

[alfrimpaPartecipante alfrimpa Karma: 33 pts]

In un If devi usare la funzione IsError() combinata a WorksheetFunction.VLookup che è il CERCA.VERT() lato VBA ed ha la medesima sintassi.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

mflauto ha scritto:

 è possibile trasformare questa formula di Excel in una istruzione VBA?

Ti serve un'istruzione di ricerca, io userei il metodo Find di un oggetto Range:

s = ""
set f = worksheets("DB").range("B2:B300").find(range("C15", lookin:=xlvalues, lookat:=xlwhole))
if not f is nothing then s = f.offset(,1)
if s <>"" then msgbox s else msgbox "Not found"

 

[tempusfugitPartecipante tempusfugit]

Grazie Vecchio Frac, 

ma la tua istruzione mi da errore; ho provato sena l'if tu dici che può andare? tieni presente che avrò da analizzare circa 5.000 righe.

 Range("E2:E1000").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],DB!R2C2:R300C3,2,0),"""")"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E1000"), Type:=xlFillDefault
    Range("E2:E1000").Select

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

tempusfugit ha scritto:

ma la tua istruzione mi da errore

Ho scritto di getto ma è facile capire che manca una parentesi dopo Range("C15" ) 🙂

Scrivere formule nel foglio con VBA è come scriverle direttamente... che gusto c'è? 😀

[mflautoPartecipante mflauto Karma: 1 pt]

Buongiorno,

continua a darmi errore, posso mandarti il file con il codice?

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Sì certo, allega il file.

[mflautoPartecipante mflauto Karma: 1 pt]

Vecchio Frac,

 ti allego il file ed il codice VBA, il file può contenere anche 5.000 righe; un'altra domanda se volessi dal foglio "Elaborato" generare in modo automatico una Pivot su un foglio dal nome Pivot come devo fare (ho utilizzato il registratore di macro; ma non è preciso).

`Option Explicit

'--------->>
Public Sub Elabora()

    Application.ScreenUpdating = False ' velocizza la macro e non ti fa vedere quello che fa
    
       
    Sheets("FattureIP").Select 'SELEZIONA IL FOGLIO FattureIP
    
    Dim WB As Workbook
    Dim srcSH As Worksheet, destSH As Worksheet
    Dim srcRng As Range, destRng As Range
    Dim Rng As Range, rArea As Range
    Dim LRow As Long
    Dim CalcMode As Long
    Dim S As Long
    Dim f As Long

    Const sFoglioSorgente As String = "FattureIp"               '<<=== Modifica
    Const sFoglioDestinazione As String = "Elaborato"         '<<=== Modifica
    Const sColonneDaCopiare As String = "A:AW"         '<<=== Modifica
    Const sPrimaCellaDestinazione As String = "A1"          '<<=== Modifica

    Set WB = ThisWorkbook
    With WB
        Set srcSH = .Sheets(sFoglioSorgente)
        Set destSH = .Sheets(sFoglioDestinazione)
    End With

    With srcSH
        LRow = LastRow(srcSH, .Columns("A:A"))
        Set srcRng = .Range(sColonneDaCopiare)
    End With

    Set destRng = destSH.Range(sPrimaCellaDestinazione)
    On Error GoTo XIT
      With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    For Each rArea In srcRng.Areas
        Set Rng = rArea.Resize(LRow)
        Rng.Copy Destination:=destRng
        Set destRng = destRng.Offset(0, Rng.Columns.Count)
    Next rArea

XIT:
    With Application
        .Calculation = CalcMode
        .ScreenUpdating = True
    End With
    
    Sheets("Elaborato").Select 'SELEZIONA IL FOGLIO ELABORATO
    
    Range("A:C,F:I,K:O,R:X,AA:AA,AK:AK,Q:Q,AD:AJ,AL:AL,AR:AS,AW:AW").EntireColumn.Delete 'elimina le colonNe selezionate
          
    Columns("E:E").Select      'AGGIUNGE UNA COLONNA
    Selection.Insert Shift:=xlToRight
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Direzione" ' LA NOMINA DIREZIONE
    Columns("E:E").Select
    
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Lotto" ' NOMINA LA CELLA LOTTO
    
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Sconto" ' NOMINA LA CELLA sconto
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Prezzo Unitario" ' NOMINA LA CELLA sconto
    
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Fatturato IVA Esclusa" ' LA NOMINA fatturato IVA esclusa
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Fatturato IVA Insclusa" ' LA NOMINA fatturato IVA esclusa
    
    Range("E2:E1000").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],DB!R2C2:R300C3,2,0),"""")"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E1000"), Type:=xlFillDefault
    Range("E2:E1000").Select
 
    Range("A1:Q1").Select ' ATTIVA IL FILTRO
    Selection.AutoFilter
    
    Columns("C:Q").EntireColumn.AutoFit
    
   ' Worksheets("Elaborato").UsedRange.Copy Destination:=Worksheets("Foglio1").Range("A1") ' copia il foglio Elaborato nel foglio1 dalla cella A1
    
    'Sheets("Foglio1").Select 'SELEZIONA IL FOGLIO1
    
    Columns("A:B").EntireColumn.AutoFit
    
    Call MsgBox( _
             Prompt:="Elaborazione Finita!", _
             Buttons:=vbInformation, _
             Title:="REPORT")
             
     Application.ScreenUpdating = True ' velocizza la macro e non ti fa vedere quello che fa
    
    
End Sub

'--------->>
Public Function LastRow(SH As Worksheet, _
                        Optional Rng As Range, _
                        Optional minRow As Long = 1)
    If Rng Is Nothing Then
        Set Rng = SH.Cells
    End If

    On Error Resume Next
    LastRow = Rng.Find(What:="*", _
                       after:=Rng.Cells(1), _
                       lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
    If LastRow < minRow Then
        LastRow = minRow
    End If
End Function

`

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Abbi pazienza ma dovresti spiegare che cosa vuoi ottenere... perché inserirsi in un sistema così complesso senza avere l'obiettivo è un po' dura soprattutto dopopranzo 🙂

Sulla pivot in automatico, il registratore di macro è una buona partenza ma poi secondo me il foglio pivot va terminato a mano perché non credo che sia completamente pilotabile.

[mflautoPartecipante mflauto Karma: 1 pt]

Vecchio Frac, mi prendi in giro!

Scherzi a parte la routine non fa altro che copiare il foglio fattureIP filtrarlo di tutti i campi inutili incollarlo nel folder Elaborato e associare il DB delle targhe al proprietario!

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

mflauto ha scritto:

mi prendi in giro!

Non è certamente mia intenzione... se me lo avevi già spiegato ti chiedo scusa e vedrò di fare mente locale per recuperare.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Tutti quei Select e FormulaR1C1, si può semplificare il codice, non serve preselezionare il range per farci qualcosa, si può farlo direttamente:

Columns("E:E").Select 'AGGIUNGE UNA COLONNA
Selection.Insert Shift:=xlToRight

diventa

Columns("E:E").Insert Shift:=xlToRight

La parte individuata dalla label XIT va ovviamente in fondo al codice (è un tappo di uscita se si verifica qualche errore).

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ma a parte qualche ottimizzazione, il codice funzina benissimo, a parte eliminare del tutto la riga

Range("E2").AutoFill Destination:=Range("E2:E1000"), Type:=xlFillDefault

che altrimenti annulla formula con VLOOKUP che hai appena scritto.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ho semplificato il codice e ottimizzato, vedi tu se tenere questo o apportare la modifica che ti ho detto al tuo: ti basta eliminare la riga di Autofill e tutto funziona.

Public Sub Elabora()
Dim CalcMode As Long
Dim j As Long
Dim r As Range

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
       
    On Error GoTo XIT
    
    '-----------------------------------------------------------------------------------
    j = [COUNTA(FattureIP!A:A)]
    With Worksheets("FattureIP")
        Set r = .Range(.Cells(1, 1), .Cells(j, "AW"))
    End With
    r.Copy Worksheets("Elaborato").Range("A1")
    '-----------------------------------------------------------------------------------
    
    With Worksheets("Elaborato")
    
        .Range("A:C,F:I,K:O,R:X,AA:AA,AK:AK,Q:Q,AD:AJ,AL:AL,AR:AS,AW:AW").EntireColumn.Delete
          
        .Columns("E:E").Insert Shift:=xlToRight
        .Range("E1") = "Direzione"
        .Range("D1") = "Lotto"
        .Range("K1") = "Sconto"
        .Range("L1") = "Prezzo Unitario"
        .Range("M1") = "Fatturato IVA Esclusa"
        .Range("N1") = "Fatturato IVA Insclusa"
    
        .Range("E2:E" & j) = "=IFERROR(VLOOKUP(RC[-2],DB!R2C2:R300C3,2,0),"""")"
        .Columns("A:Q").EntireColumn.AutoFit
    
        .Range("A1:Q1").AutoFilter
    End With
        
        MsgBox "Elaborazione Finita!", vbInformation + vbOKOnly, "REPORT"
             
XIT:
    With Application
        .Calculation = CalcMode
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
    
End Sub

[mflautoPartecipante mflauto Karma: 1 pt]

Vecchio Frac ma se la commento, mi associa solo la targa della cella E2! ti allego il file.

Poi se riesco (spero anche con il tuo prezioso aiuto) mi creo la Pivot.

Range("E2:E1000").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],DB!R2C2:R300C3,2,0),"""")"
    Range("E2").Select
    'Selection.AutoFill Destination:=Range("E2:E1000"), Type:=xlFillDefault
    'Range("E2:E1000").Select

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Eh già, perché non hai guardato la mia modifica 🙂

Il tuo codice dice:

Range("E2:E1000").Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],DB!R2C2:R300C3,2,0),"""")"

Il mio codice dice:

Range("E2:E1000").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],DB!R2C2:R300C3,2,0),"""")"

Vedi la differenza? Poi vabbè, io ho fatto altre semplificazioni ma non è questo che stiamo discutendo (e comunque l'avrei riscritto utilizzando il Find di cui parlavo a inizio thread).

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Già che ci sono allego la proposta con Find. Se interessa, tanto per cambiare orizzonte 🙂

Sulla pivot ci dobbiamo studiare su un attimo.

Allegati:

You must be logged in to view attached files.

[mflautoPartecipante mflauto Karma: 1 pt]

Vecchio Frac,

chapeau!!!

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Hai messo Risolto, ma non abbiamo ancora affrontato la quesitone tabella pivot.

Che risultato avevi in mente di ottenere? Secondo me se te la imposti a mano, fai prima e meglio. Certi automatismi sono sempre complicati da controllare.

[Max Max]

Vecchio Frac,

l'argomento principale è stato da te risolto! Più che altro era una sfida, ho provato con il registratore di macro, ma vengono fuori certi arrosti. Appena posso ti mando lo script.

Grazie per avermi erudito. Mf

[mflautoPartecipante mflauto Karma: 1 pt]

Buonasera Vecchio Frac,

ho apportato delle modiche al codice per inserire la colonna "F" , rinominarla e fargli ricercare nel DB la colonna "E" tipologia di veicolo; ho provato a , modificare il tuo codice ma ho fatto dei casini: Columns("E:E;F:F").Insert Shift:=xlToRight 'AGGIUNGE LE COLONNE "E&F", ho iserito questa istruzione che sul mio funziona ma sul tuo mi crea casini ( Range("F2:F800").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-3],DB!R2C2:R300C5,4,0),"""")")...

ption Explicit

'--------->>
Public Sub Elabora()

    Application.ScreenUpdating = False ' velocizza la macro e non ti fa vedere quello che fa
    
       
    Sheets("FattureIP").Select 'SELEZIONA IL FOGLIO FattureIP
    
    Dim WB As Workbook
    Dim srcSH As Worksheet, destSH As Worksheet
    Dim srcRng As Range, destRng As Range
    Dim Rng As Range, rArea As Range
    Dim LRow As Long
    Dim CalcMode As Long
    Dim S As Long
    Dim f As Long

    Const sFoglioSorgente As String = "FattureIp"               '<<=== Modifica
    Const sFoglioDestinazione As String = "Elaborato"         '<<=== Modifica
    Const sColonneDaCopiare As String = "A:AW"         '<<=== Modifica
    Const sPrimaCellaDestinazione As String = "A1"          '<<=== Modifica

    Set WB = ThisWorkbook
    With WB
        Set srcSH = .Sheets(sFoglioSorgente)
        Set destSH = .Sheets(sFoglioDestinazione)
    End With

    With srcSH
        LRow = LastRow(srcSH, .Columns("A:A"))
        Set srcRng = .Range(sColonneDaCopiare)
    End With

    Set destRng = destSH.Range(sPrimaCellaDestinazione)
    On Error GoTo XIT
      With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    For Each rArea In srcRng.Areas
        Set Rng = rArea.Resize(LRow)
        Rng.Copy Destination:=destRng
        Set destRng = destRng.Offset(0, Rng.Columns.Count)
    Next rArea

XIT:
    With Application
        .Calculation = CalcMode
        .ScreenUpdating = True
    End With
    
    Sheets("Elaborato").Select 'SELEZIONA IL FOGLIO ELABORATO
    Range("A:C,F:I,K:O,R:X,AA:AA,AK:AK,Q:Q,AD:AJ,AL:AL,AR:AS,AW:AW").EntireColumn.Delete 'elimina le colonNe DESCRITTE
    Columns("E:E").Insert Shift:=xlToRight     'AGGIUNGE LA COLONNA "E"
    Range("E1").Select ' SELEZIONA LA CELLA "E1"
    ActiveCell.FormulaR1C1 = "Direzione" ' RINOMINA LA CELLA DIREZIONE
    Columns("E:E").Select
    Columns("F:F").Insert Shift:=xlToRight  'AGGIUNGE LA COLONNA "F"
    Range("F1") = "Tipologia"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Lotto" ' RINOMINA LA CELLA LOTTO
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Prodotto" ' RINOMINA LA CELLA LOTTO
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Sconto" ' RINOMINA LA CELLA sconto
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Prez.Unit." ' RINOMINA LA CELLA Prez.Unit.
    
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Fatt.IVA Esclusa" ' RINOMINA LA CELLA fatturato IVA esclusa
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Fatt.IVA Inclusa" ' RINOMINA LA CELLA fatturato IVA Inclusa
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Imp.Fatt.IVA Inclusa" ' RINOMINA LA CELLA Imp.Fatt.IVA Inclusa"
        

    Range("E2:E800").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],DB!R2C2:R300C3,2,0),"""")"
    Range("F2:F800").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-3],DB!R2C2:R300C5,4,0),"""")"
     
    Range("A1:R1").Select ' ATTIVA IL FILTRO
    Selection.AutoFilter
    
    Columns("B:R").EntireColumn.AutoFit 'AUTO ADATTA LE COLONNE DALLA "B" ALLA "R" AL CONTENUTO
    
   ' Worksheets("Elaborato").UsedRange.Copy Destination:=Worksheets("Foglio1").Range("A1") ' copia il foglio Elaborato nel foglio1 dalla cella A1
    
    'Sheets("Foglio1").Select 'SELEZIONA IL FOGLIO1
           
    Call MsgBox( _
             Prompt:="Elaborazione Finita!", _
             Buttons:=vbInformation, _
             Title:="REPORT")
             
     Application.ScreenUpdating = True ' velocizza la macro e non ti fa vedere quello che fa
    
    
End Sub

'--------->>
Public Function LastRow(SH As Worksheet, _
                        Optional Rng As Range, _
                        Optional minRow As Long = 1)
    If Rng Is Nothing Then
        Set Rng = SH.Cells
    End If

    On Error Resume Next
    LastRow = Rng.Find(What:="*", _
                       after:=Rng.Cells(1), _
                       lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
    If LastRow < minRow Then
        LastRow = minRow
    End If
End Function

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ciao Massimiliano scusa ma non ho capito  (e ti pareva che capivo qualcosa subito 🙂 )

Citi il mio codice ma mostri il tuo e quindi non ho capito a quale errore ti riferisci di preciso (quali sono questi "casini" che ottieni?)

[tempusfugitPartecipante tempusfugit]

Buonasera Vecchio Frac,

io sono un dinosauro e diciamo che riesco a scrivere 4 righe di codice avendo imparato da autodidatta; la tua soluzione con l'istruzione find accorcia e velocizza di molto il codice, copiando parte del tuo codice e modificando a ca@@o ho pensato che: Columns("E:E").Insert Shift:=xlToRight 'aggiunge la colonna "E" quindi Columns("E:E;FF").Insert Shift:=xlToRight ' dovrebbe aggiungere 2 colonne (e fin qui tutto bene).

Poi se  .Range("E1") = "Direzione" -  .Range("F1") = "Tipologia" ed infine  Range("E2:E800").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],DB!R2C2:R300C3,2,0),"""")" Range("F2:F800").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-3],DB!R2C2:R300C5,4,0),"""")" 

Con il mio codice da boomer mi funziona, con il tuo no! sicuramente sbaglio qualche ciclo o qualche array.

Grazie per il tuo prezioso aiuto 🙂

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Credo che interpretando la tua formula la modifica al mio codice sia semplice.

        For Each cell In Range("C2:C" & j)
            i = i + 1
            Set r = Worksheets("DB").Range("B:B").Find(cell, LookIn:=xlValues, lookat:=xlWhole)
            If Not r Is Nothing Then
                cell.Offset(, 2) = r.Offset(, 1)
                cell.Offset(, 3) = r.Offset(, 3)
            End If
        Next

Spazzola ogni cella della colonna C del foglio Elaborato. Se nella colonna B del foglio DB trovi il valore in colonna C di Elaborato, in colonna E di Elaborato metti il contenuto della colonna C di DB (E2:E800=SE.ERRORE(CERCA.VERT(C2;DB!$B$2:$C$300;2;0);""))  e in colonna F di Elaborato metti il contenuto della colonna E di DB (F2:F800=SE.ERRORE(CERCA.VERT(C2;DB!$B$2:$E$300;4;0);""))

 

[Max Max]

Buonasera Vecchio Frac,

Ho fatto un altro piccolo progettino, se domani pubblico il post posso contare sul tuo aiuto?

[Autore]

Articoli