Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

macro cerca e inserisci

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

macro cerca e inserisci

Postdi zorea » 21/12/10 18:11

Ciao :)
scopiazzando qua e là, ho buttato giù la macro che segue.
Sostanzialmente:
- verifico se il valore che inserisco nella cella C4 del foglio1 (partita iva) è presente nella tabella/"db" del foglio2 (stessa cartella):
se vero, mi rende alcune informazioni presenti in tabella/"db" (ne ho inserito solo una parte); se falso, mi restituisce una MsgBox, che mi suggerisce l'inserimento dei dati (per il popolamneto della tabella/"db" stessa, che effettuerò con la sub Copia)

2 domande:
la prima: vorrei, se possibile, inserire direttamente la "sub copia" dopo aver inserito tutti i dati, senza passare per il "click" sul pulsante ad essa associato. (Nessun campo deve rimanere vuoto, nel caso indicato b6, b8, c6, c8).
la seconda: la prima colonna della tabella/"db" è un contatore, che ora ho impostato con la funzione SE (che controlla la presenza della piva); vorrei però inserirlo sempre nel codice,ma o mi va in errore, o mi parte da 0. :( (esercizio 1 della prima ora di un qualsiasi corso vba, immagino... e io mi perdo!!! :oops: )

Sperando di essere stata sufficientemente chiara, attendo un vostro aiuto.

Grazie,
zorea :)
ps: nella sub copia la riga di codice Set originedati= Sheets(1).Range("B2:F2") è perchè "qui dentro" ho messo i dati che ho inserito ex-novo, per "ordinarl"i rispetto alla tabella/"db"
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C4")) Is Nothing Then
Exit Sub

Else

Dim CL As Object
X = [C4].Value
Set originedati= Sheets(2).Range("B2:B200")
For Each CL In originedati
If CL.Value = X Then
[B6] = CL.Offset(0, 1).Value 'nome azienda
[B8] = CL.Offset(0, 2).Value 'telefono
[C6] = CL.Offset(0, 3).Value 'referente
[C8] = CL.Offset(0, 4).Value 'e-mail referente
Exit Sub
End If
Next
MsgBox "P.IVA non presente. Verificare o inserire i campi evidenziati in giallo."
Range("B6,B8,C6,C8").ClearContents
End If
End Sub


Sub Copia()
Application.ScreenUpdating = False
Set originedati= Sheets(1).Range("B2:F2")
Sheets(2).Activate
Dim iRow As Integer
iRow = 1
With Worksheets("Foglio2")
While .Cells(iRow, 2).Value <> ""
iRow = (iRow + 1)
Wend
.Cells(iRow, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End With

Sheets(1).Activate
Application.CutCopyMode = False
Range("B6,B8,C4,C6,C8").ClearContents
End Sub
zorea
Utente Junior
 
Post: 48
Iscritto il: 05/06/09 15:07

Sponsor
 

Re: macro cerca e inserisci

Postdi Anthony47 » 21/12/10 23:26

Io la prima parte della macro la eliminerei, e la sostituirei con la formula Cerca.Vert nel foglio; poi nella Worksheet_Change farei un test se B6 e' in errore (tramite If IsError(Range("B6").Value) Then etc etc)

La sub Copia vedo che fa un PasteSpecial, ma di cosa, visto che manca una Copy?
Ma siccome non e' necessario fare PasteSpecial (basta Copy & Paste, visto che sono dati digitati), puoi usare direttamente
Codice: Seleziona tutto
Sheets(1).Range("B2:F2").Copy Destination:=Sheets(2).Range("B" & Rows.Count).End(Xlup).Offset(1,0)
Questa istruzione sostituisce tutto eccetto Sub Copia() / Range("B6,B8,C4,C6,C8").ClearContents / End Sub. Non ho capito perche' non hai inserito anche il Clear di B2:F2 e magari un msgbox che informa che i dati sono stati accodati all' anagrafica.

Per quanto riguarda la col A di Foglio(2) non ho capito il discorso; forse e' un controllo che la partita Iva non venga inserita due volte? In questo caso potresti mettere una convalida su Foglio(1), in B2 (credo) del tipo "Personalizzato" e la formula =CONTA.SE(Foglio2!D:D;B2)=0
(ho immaginato che Foglio(2) si chiami Foglio2).
In questo modo non potrai inserire in B2 una P.Iva che esiste gia' in elenco.

Per quanto riguarda far partire Copia a compilazione completata, devi ampliare la testata della Worksheet_Change, per controllare piu' eventi. Qualcosa come:
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address="$C$4" Then Call LaPrimaMacro
If Not Intersect(Target, Range("B2:F2")) Is Nothing Then Call Copia
Exit Sub

In testa a Copia inserirai il controllo che nessuna cella sia vuota, ad esempio con
Codice: Seleziona tutto
If Application.WorksheetFunction.CountBlank(Range("B2:F2")) > 0 Then Exit Sub
In questo caso e' obbligatorio il Clear di B2:F2 di Foglio(1).

Infine un commento: Set e With sono statements che aiutano l' esperto a migliorare la forma del proprio codice (non la sostanza); fintanto che non sei a un livello "medio" ti consiglio di trascurarli ricorrendo all' esplicitazione della voce nel codice; ad esempio, senza With:
While Worksheets("Foglio2").Cells(iRow, 2).Value <> ""

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13904
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro cerca e inserisci

Postdi zorea » 27/12/10 09:53

Grazie! :)
Tutto chiaro e funzionante come sempre.

(Per pulire il codice dai miei commenti, mi sono persa la riga che avevo copiato, il paste special era perchè copiavo una formula, e anche la questione del Set e With ... non cercavo finezze ma solo un modo che a me sembrava semplice... comunque lo scrivo solo per farti sapere che ho letto e accolto ogni suggerimento... :) Grazie anche per la pazienza!)

zorea
zorea
Utente Junior
 
Post: 48
Iscritto il: 05/06/09 15:07


Torna a Applicazioni Office Windows


Topic correlati a "macro cerca e inserisci":


Chi c’è in linea

Visitano il forum: Nessuno e 7 ospiti