inputbox in formula

Hai un problema con Excel?

Nuova discussione

inputbox in formula
di rplacanica (utente non iscritto) data: 12/11/2012 15:32:13
Buongiorno a tutti,
ho iniziato da poco a maneggiare i codici VBA e oggi mi sto impantanando in uno scadenziario clienti fornitori.
insomma dopo aver importato un bel txt estratto da AS400, vorrei che il vba mi inserisse in una colonna il mio bel "scaduto" o "a scadere" in funzione della data che inserisco come parametro nell'Inputbox.
come faccio a far recepire di utilizzare il mio DATESCAD all'interno della funzione

Range("v2:v" & LAST_ROW). FormulaR1C1 = "=+IF(RC[-15]< [qui devo far inserire ciò che mi occorre] ,""scaduto"",""a scadere"")"

a monte ho già indicato che

LAST_ROW = ActiveCell.SpecialCells(xlLastCell).Row

While DATESCAD = ""
DATESCAD = Application.InputBox("Considero scadute le fatture anteriori al", "Inserire data scadenza")
Wend
If DATESCAD = False Then Exit Sub

sotto riporto tutto il codice, nel caso in cui qualcuno possa aiutarmi a renderlo più semplice...visto che ho anche un problema sulle celle vuote, che vorrei forzare su "euro"

Set LAST_ROW2 = ActiveCell.SpecialCells(xlLastCell).Row
Range("P2:v" & LAST_ROW2).Replace What:="", Replacement:="EURO"
non funziona...

ps.: se può essere d'aiuto, mi sto "formando" sul testo di Giaccaglini - Excel e office VBA
Grazie in anticipo!

Sub IMPORT_SCADENZARI()
'
' IMPORT SCADENZARI Macro
' Creata da Roberto Placanica 15/10/2012
'
'
Dim varFileName
Dim LAST_ROW As Integer
Dim COMP As String
Dim UltimaRigaFiltro As Integer
Dim DATESCAD As Date

With Application
.ScreenUpdating = True
.DisplayAlerts = False
End With

Workbooks.Add
    
    varFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If TypeName(varFileName) = "String" Then
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & varFileName, Destination:=Range("A1"))
            .Name = "Import da AS400"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 61
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(11, 11, 7, 7, 7, 7, 16, 15, 17, 2, 4, 11, 17)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    
    Sheets.Add After:=Sheets(Sheets.Count)
        
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & varFileName, Destination:=Range("A1"))
            .Name = "Import da AS400"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 60
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1)
            .TextFileFixedColumnWidths = Array(132)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End If

While COMP = ""
COMP = Application.InputBox("Società", "inserire nome società", "miasocietà")
Wend
If COMP = False Then Exit Sub

While DATESCAD = ""
DATESCAD = Application.InputBox("Considero scadute le fatture anteriori al", "Inserire data scadenza")
Wend
If DATESCAD = False Then Exit Sub

'dal foglio2 ricavo i nomi dei clienti, poi elimino il folgio
    
    Sheets("Foglio2").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Foglio1").Select
    Columns("N:N").Select
    ActiveSheet.Paste
    Sheets("Foglio2").Select
    ActiveWindow.SelectedSheets.Delete
    
'trovo l 'ultima cella attiva e memorizzo la riga
 LAST_ROW = ActiveCell.SpecialCells(xlLastCell).Row

' inserisco la colonna con il mome della società
    
    Columns("A:A").Insert Shift:=xlToRight
    Range("A1") = "Società"
    Range("a2:A" & LAST_ROW).Value = COMP
    
'inserisco le intestazioni dei campi
    Range("b1") = "Codice Cliente"
    Range("c1") = "Partita"
    Range("D1") = "Data_doc_txt"
    Range("e1") = "Doc"
    Range("f1") = "Registr"
    Range("g1") = "TP"
    Range("h1") = "Contanti"
    Range("i1") = "Effetti"
    Range("j1") = "Altro"
    Range("k1") = "P"
    Range("l1") = "Div"
    Range("m1") = "Cambio"
    Range("n1") = "Importo in Div"
    Range("o1") = "Cliente"
    Range("p1") = "Scadenza"
    Range("Q1") = "Anno"
    Range("R1") = "Mese"
    Range("S1") = "Data_doc"
    Range("T1") = "Estrazione"
    Range("U1") = "Settimana"
    Range("V1") = "Scaduto"
    
 '   inserisco le formule dei campi

    Range("P2:P" & LAST_ROW) = "=IF(LEFT(RC[-14],8)=""Scadenza"",RC[-13],R[-1]C[])"
    Range("P2:P" & LAST_ROW).NumberFormat = "dd-mm-yy"
    
    Range("Q2:q" & LAST_ROW) = "=IFERROR(YEAR(RC[-1]),"""")"
    Range("R2:r" & LAST_ROW) = "=IFERROR(MONTH(RC[-2]),"""")"
    Range("S2:s" & LAST_ROW) = "=+IF(RC[-15]<>0,RC[-15],"""")"
    Range("s2:s" & LAST_ROW).NumberFormat = "dd-mm-yy"
    Range("T2:t" & LAST_ROW) = "=TEXT(IFERROR(AND(VALUE(RC[-14]),VALUE(RC[-18])),""FALSO""),0)"
    Range("U2:u" & LAST_ROW) = "=WEEKNUM(RC[-5],1)"
    Range("v2:v" & LAST_ROW).FormulaR1C1 = "=+IF(RC[-15]<&DATESCAD  ,""scaduto"",""a scadere"")"

    End With
'copia e incolla i valori
       
    ' se non funziona quello sotto togliere gli apici qui sotto da A a D
    Range("P2:v" & LAST_ROW).Select
    For Each c In Selection
    c.Value = c.Value
    Next
    'A Selection.Copy
    'B Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'C Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'D Application.CutCopyMode = False

'   elimino le celle inutili
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("A1:t" & LAST_ROW).AutoFilter Field:=20, Criteria1:="FALSO"
    UltimaRigaFiltro = Range("A1").End(xlDown).Row
    Rows("2:" & UltimaRigaFiltro).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData
    
    Set LAST_ROW2 = ActiveCell.SpecialCells(xlLastCell).Row
    Range("P2:v" & LAST_ROW2).Replace What:="", Replacement:="EURO"
    
'Creo Le pivot
    PIVOT
    Application.ScreenUpdating = True
 
End Sub

di Vecchio Frac data: 12/11/2012 16:30:12
Il testo di Gianni Giaccaglini è perfetto. Io seguivo Giaccaglini fin da quando faceva il redattore su PcFloppy già nel 1987, è il mio Maestro ma lui non lo sa :)

Stai costruendo una stringa, trattala come tale concatenando gli elementi a disposizione:
è sbagliata questa:
Range("v2:v" & LAST_ROW).FormulaR1C1 = "=+IF(RC[-15]<&DATESCAD ,""scaduto"",""a scadere"")"

ma è giusta questa:
Range("v2:v" & LAST_ROW).FormulaR1C1 = "=+IF(RC[-15]<" & DATESCAD & " ,""scaduto"",""a scadere"")"
sempre ammesso che DATESCAD contenga una stringa valida.

Tutto il codice potrebbe subire un bel maquillage per essere sfrondato, ridotto, sintetizzato e ottimizzato (devi scusarmi, la mia mania dell'evitare ridondanze si fa sentire quasi in ogni post qui ^_^). Non ho molto tempo adesso, ma se vuoi possiamo rivederlo insieme (se qualcun altro non interviene prima di me).
di rplacanica data: 12/11/2012 16:39:15
Grazie!
in effetti hai ragione ho provato per stanchezza e tra un Vaffa e l'altro ho inserito la "" e per magia :) tutto ha funzionato....
ma ho ottenuto solo dei FALSO...mancava infatti la seconda & seguito da"
ti ringrazio per la disponibilità nel voler aiutarmi a "pulire" il codice visto che anche questo aiuta a migliorare!
grazie ancora!!
di Francesco (utente non iscritto) data: 12/11/2012 18:32:19
(scusate se mi inserisco) e per magia adesso so cosa comprare come testo per vba!!! ^_^
di Vecchio Frac data: 12/11/2012 18:46:01
cit. " adesso so cosa comprare come testo per vba "
---> Sì, ma sono comunque necessari la pratica, il continuo esercizio, la lettura di codice altrui (possibilmente funzionante), la frequentazione di appositi forum dove sono presenti utenti gentili, disponibili e competenti (^_^).
di rplacanica (utente non iscritto) data: 12/11/2012 18:53:44
quote
" adesso so cosa comprare come testo per vba "
---> Sì, ma sono comunque necessari la pratica, il continuo esercizio, la lettura di codice altrui (possibilmente funzionante), la frequentazione di appositi forum dove sono presenti utenti gentili, disponibili e competenti (^_^).
unquote

Vecchio Frac hai perfettamente ragione... altrimenti bastasse il libro non sarei qui....
ho bisogno ancora di una mano... e quindi apro un secondo post :)
di Francesco (utente non iscritto) data: 12/11/2012 19:10:03
Dispongo di tutto tranne del libro: ho buona costanza, ho letto codici di persone competenti e conosco un forum che è proprio l'ideale (anche se non ha icona che sbatta la testa lol).
Devo solo registrarmi ^_^
di Vecchio Frac data: 12/11/2012 20:30:50
Domanda: che bisogno c'è di creare un nuovo Workbook? (--> inizio codice)

Domanda: che bisogno c'è, nel tuo codice, di un doppio "ActiveSheet.QueryTables.Add" di cui il primo nel foglio corrente, l'altro in un nuovo foglio? solo a memorizzarne alcuni dati? per poi distruggerlo senza fare altro? non ce n'è bisogno. Recupera semplicemente i dati dalla prima QueryTable impostata e assegna i valori ad alcune variabili.

Domanda: dov'è la Sub "PIVOT" di cui alla fine del codice?
di Rplacanica (utente non iscritto) data: 12/11/2012 21:56:51
Il nuovo wb lo creo perchè distribuisco la macro ai singoli utenti come "tastino" sulla barra degli strumenti. Evito in pratica che lancino la macro su un foglio di lavoro giá aperto

La seconda importazione mi occorre perchè la prima mi separa il txt in colonne. Il txt è una stampa di un estratto conto, quindi già impaginato e separato...per cliente
Per le mie conoscienze mi veniva più semplice reiportare con una riga in più il file in unica colonna e incollarlo sul precedente foglio, come colonna aggiuntiva.
In questo modo ciascuna riga/partita riesce ad essere immediatamente abbinata al cliente.
Credo che sarebbe più semplice allegare tutto per facilitare la comprensione, ma ora sono a casa e non ho il pc con me.

La pivot era su un secondo codice... Che mi son dimenticato di incollare

di Vecchio Frac data: 12/11/2012 21:57:25
Allego il codice riveduto e leggermente modificato.
Naturalmente per testarlo mi servirebbe un file di esempio che non ho e non so come ricostruire :)
Quindi sicuramente provandolo potresti ottenere degli errori.
Ma la filosofia è quella della semplificazione che puoi vedere confrontando il codice originale con il mio.

Se potessi allegare un file di esempio potrei essere più preciso anche nel risolvere gli errori (che nel listato originale ci sono: variabili non dichiarate e un End With inconsistente).

Sulla tua domanda iniziale relativa al valore EURO:
Range("P2:v" & LAST_ROW2).Replace What:="", Replacement:="EURO"
cosa intendevi ottenere? una formattazione a valuta o la sostituzione del testo con la parola EURO?

Option Explicit

Sub IMPORT_SCADENZARI()
'
' IMPORT SCADENZARI Macro
' Creata da Roberto Placanica 15/10/2012
'
' (some edits by Vecchio Frac)

Dim varFileName
Dim LAST_ROW As Integer
Dim COMP As String
Dim UltimaRigaFiltro As Integer
Dim DATESCAD As Date
Dim i As Integer, c As Variant

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    varFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If varFileName = False Then Exit Sub
    
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & varFileName, Destination:=Range("A1"))
        .Name = "Import da AS400"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 61
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(11, 11, 7, 7, 7, 7, 16, 15, 17, 2, 4, 11, 17)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    While COMP = ""
        COMP = InputBox("Società", "inserire nome società", "miasocietà")
    Wend
    If COMP = False Then Exit Sub
    
    While DATESCAD = ""
        DATESCAD = InputBox("Considero scadute le fatture anteriori al", "Inserire data scadenza")
    Wend
    If DATESCAD = False Then Exit Sub

    'dal foglio ricavo i nomi dei clienti, quindi li ricopio in colonna N
    [A:A].Copy [N:N]

    'trovo l 'ultima cella attiva e memorizzo la riga
    LAST_ROW = [COUNTA(A:A)]
    
    ' inserisco la colonna con il mome della società
    Columns("A:A").Insert Shift:=xlToRight
    Range("A1") = "Società"
    Range(Cells(2, 1), Cells(LAST_ROW, 1)) = COMP
        
    'inserisco le intestazioni dei campi
    For i = 2 To 22
        Cells(1, i) = Choose(i, "Codice Cliente", "Partita", "Data_doc_txt", "Doc", "Registr", _
            "TP", "Contanti", "Effetti", "Altro", "P", "Div", "Cambio", "Importo in Div", "Cliente", _
            "Scadenza", "Anno", "Mese", "Data_doc", "Estrazione", "Settimana", "Scaduto")
    Next
    
    'inserisco le formule dei campi
    On Error Resume Next
    For i = 2 To LAST_ROW
        'colonna P
        Cells(i, 16) = IIf(Left(Cells(i, 2), 8) = "Scadenza", Cells(i, 3), Cells(i - 1))
        Cells(i, 16).NumberFormat = "dd-mm-yy"
        'colonna Q
        Cells(i, 17) = Year(Cells(i, 16))
        'colonna R
        Cells(i, 18) = Month(Cells(i, 16))
        'colonna S
        Cells(i, 19) = IIf(Cells(i, 4) <> 0, Cells(i, 4), "")
        Cells(i, 19).NumberFormat = "dd-mm-yy"
        'colonna T
        Cells(i, 20) = Cells(i, 6) And Cells(i, 2)
        'colonna U
        Cells(i, 21) = DatePart("ww", Cells(i, 16))
        'colonna V
        Cells(i, 22) = IIf(Cells(i, 7) < DATESCAD, "scaduto", "a scadere")
    Next
    On Error GoTo 0
    
    '   elimino le celle inutili
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("A1:t" & LAST_ROW).AutoFilter Field:=20, Criteria1:="FALSO"
    UltimaRigaFiltro = Range("A1").End(xlDown).Row
    Rows("2:" & UltimaRigaFiltro).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData
        
    Set LAST_ROW2 = ActiveCell.SpecialCells(xlLastCell).Row
    Range("P2:v" & LAST_ROW2).Replace What:="", Replacement:="EURO"
    
    'Creo Le pivot
    PIVOT
    Application.ScreenUpdating = True
 
End Sub

di Vecchio Frac data: 12/11/2012 21:59:40
Ci siamo rincorsi coi messaggi :)
Dopo la tua spiegazione qualcosa è più chiaro e dovrai riadattare il codice proposto.
Ma se vorrai allegare quando potrai un pezzo di testo d'esempio allora potrò essere meno approssimativo.
di Rplacanica (utente non iscritto) data: 12/11/2012 22:52:50
Tema replacement
L'estratto conto non popola i campi se la valuta è euro.
Conoscendo i miei utilizzatori, se non vedono l'indicazione Euro mi dicono che non è corretto... Pertanto ho fatto in modo che per ogni cella vuota della colonna valuta sia inserito il valore "euro"

Mi piacciono molto i cicli for ....next e come inserisci i nomi campi con "choose"
Mi spieghi invece questo:
Cells(i, 16) = IIf(Left(Cells(i, 2), 8) = "Scadenza", Cells(i, 3), Cells(i - 1))

Ps grazie mille per il tuo contributo!
di Vecchio Frac (utente non iscritto) data: 13/11/2012 10:14:10
"IIf " è un operatore ternario, corrisponde alla funzione di Excel "SE(test, se_vero, se_falso)".
Valuta quindi la condizione, se risulta vera esegue la prima istruzione, altrimenti la seconda.

Questa istruzione:
Cells(i, 16) = IIf(Left(Cells(i, 2), 8) = "Scadenza", Cells(i, 3), Cells(i - 1))

imposta il valore della cella a riga "i", colonna 16 (="P") : se in cella riga "i", colonna 8 (="H") i primi otto caratteri son "Scadenza" inserisce il valore della cella in riga "i", colonna 3 (="C") altrimenti inserisce il valore della riga precedente a quella considerata (i-1), stessa colonna (cioè ancora "P").

Per sostituire rapidamente celel vuote ocn un certo testo puoi usare un trucco con le celle speciali:
myRange.specialcells(xlCellTypeBlanks) = "EURO"
dove ovviamente myRange va sostituito col riferimento di range opportuno.
di rplacanica (utente non iscritto) data: 23/11/2012 10:33:50
vorrei trasformare questa riga
Range("T2:t" & LAST_ROW) = "=TEXT(IFERROR(AND(VALUE(RC[-13]),VALUE(RC[-17])),""FALSO""),0)"
in un formato notazione come questo:
Cells(i, 19) = IIf(Cells(i, 3) <> 0, Cells(i, 3), "")

gli indici sono questi, ma a parte questo non saprei dove trovare le altre indicazioni...per completare il lavoro
Cells(i, 20) = TEXT(IFERROR(AND(VALUE(cells(i,3)),VALUE(cells(i,3))),""FALSO""),0)
di Vecchio Frac data: 23/11/2012 14:58:13
Valutando la riga:
Range("T2:t" & LAST_ROW) = "=TEXT(IFERROR(AND(VALUE(RC[-13]),VALUE(RC[-17])),""FALSO""),0)"
devi partire da T e retrocedere di tredici colonne (primo caso: RC[-13]) e diciassette colonne (secondo caso: RC[-17]), quindi arrivi rispettivamente a G (Cells(..., 7) e C (Cells(..., 3)
diventa:
for i = 2 to LAST_ROW
cells(i, 20) = iif(cells(i, 7) and cells(i, 3), 1, 0)
next

Cioè metti in AND i due valori di colonna G e colonna C, se entrambi producono un risultato vero (cioè entrambi sono numerici e diversi da zero) viene riportato 1, altrimenti 0, in colonna T.
Se invece (dal tuo post non è chiaro) volevi il risultato della cella in colonna C riportato in T qualora vero (cioè un numero diverso da zero) allora:
for i = 2 to LAST_ROW
cells(i, 20) = iif(cells(i, 3), cells(i, 3), 0)
next

...fai una prova :)
di Rplacanica (utente non iscritto) data: 24/11/2012 11:10:05
Grazie, oggi provo!

Vuoi Approfondire?