Condividi:        

MACRO e FILTRO

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 e FILTRO

Postdi borile500 » 25/08/09 12:55

Salve sono nuovo del forum :D
Ho un piccolo prob con un file excel.
Si tratta di un foglio "Archivio pazienti". I dati dei pazienti (nome, cognome e misurazioni varie, disposti su un unica riga) vengono salvati in un database nell'intervallo A500:A1000 e in automatico vengono ordinati per cognome-nome quindi per data visita, dalla più alla meno recente. Ogni paziente quindi avrà nell'intervallo A500:A1000 tante righe ordinate, quante sono state le visite.
Ho già creato 2 celle con elenco a discesa (dall'intervallo 500:1000, delle rispettive colonne) per cognome e nome che mi restituiscono in automatico nella cella A7 un codice (usando concatena cognome+nome).
Vengo al dunque:
Mi servirebbe a questo punto che con macro "carica paziente" vengano filtrate tutte le righe (500:1000) contenenti nella colonna A il codice generato in A7 e che vengano ricopiate a partire da A8 tutte le righe che contengono tale codice.
Ho provato manualmente e l'ideale sarebbe (usando la funzione trova):
1)Seleziona 500:1000,
2)Trova in foglio, copia A7, incolla valori (nel campo di ricerca di trova)
3)cerca per colonne
4)trova tutti
5)seleziona tutte le righe trovate, copia e incolla in A8

Spero di esser stato minimamente comprensibile e mi scuso per il linguaggio non tecnico utilizzato :-?
borile500
Utente Junior
 
Post: 14
Iscritto il: 25/08/09 11:36

Sponsor
 

Re: MACRO e FILTRO

Postdi Flash30005 » 25/08/09 14:50

Ciao Borile e benvenuto
In un modulo inserisci questa macro
Codice: Seleziona tutto
Sub copia()
URC = Worksheets("Foglio1").Range("A499").End(xlUp).Row
    Rows("8:" & URC).Select
    Selection.ClearContents
    Range("A7").Select
UR = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
Paziente = Worksheets("Foglio1").Range("A7").Value
riga = 8
For I = 500 To UR
    If Paziente = Worksheets("Foglio1").Range("A" & I).Value & Worksheets("Foglio1").Range("B" & I).Value Then
    Range("A" & I & ":AZ" & I).Copy Destination:=ActiveSheet.Cells(riga, 1)
    riga = riga + 1
    End If
Next I
End Sub

In A7 ho previsto che tu abbia messo il cognomenome (senza spazi)
altrimenti dovrai modificare la If delle macro
Codice: Seleziona tutto
If Paziente = Worksheets("Foglio1").Range("A" & I).Value & Worksheets("Foglio1").Range("B" & I).Value Then

dove inserito valore
Codice: Seleziona tutto
Range("A" & I).Value & Range("B" & I).Value
in
Range("A" & I).Value & " " & Range("B" & I).Value
(aggiunge uno spazio tra cognome e nome per la ricerca)

Inoltre per far avviare la macro automaticamente al variare dell cella A7 dovrai mettere sul foglio (non modulo)
questo codice
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$7" Then Call copia
End Sub


Fai sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: MACRO e FILTRO

Postdi borile500 » 29/08/09 21:50

Grazie tante per il codice, ma non mi funziona ed elimina le prime 3 righe di intestazione.
borile500
Utente Junior
 
Post: 14
Iscritto il: 25/08/09 11:36

Re: MACRO e FILTRO

Postdi Flash30005 » 30/08/09 03:00

C'è una piccola correzione da fare (non capisco come sia successo) :roll:
ma la prima riga della macro che è
Codice: Seleziona tutto
URC = Worksheets("Foglio1").Range("A499").End(xlUp).Row

deve essere con + 1 finale
così
Codice: Seleziona tutto
URC = Worksheets("Foglio1").Range("A499").End(xlUp).Row + 1



Fai sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: MACRO e FILTRO

Postdi borile500 » 30/08/09 10:21

Niente, continua a non funzionare...Temo di non esser stato chiaro io :( allego immagine

http://www.postimage.org/image.php?v=gx23CMH9
borile500
Utente Junior
 
Post: 14
Iscritto il: 25/08/09 11:36

Re: MACRO e FILTRO

Postdi borile500 » 30/08/09 10:25

la macro "salva paziente" funziona bene ed è questa:

Sub SALVATAGGIO()
'
' SALVATAGGIO Macro
'

'
Rows("3:3").Select
Application.CutCopyMode = False
Selection.Copy
Rows("1500:1500").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1500:AJ1500").Select
Application.CutCopyMode = False
Selection.Cut
Range("a499").Select
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveSheet.Paste
Rows("500:1000").Select
ActiveWindow.SmallScroll Down:=-18
ActiveWorkbook.Worksheets("Archivio clienti").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Archivio clienti").Sort.SortFields.Add Key:=Range( _
"A500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Archivio clienti").Sort
.SetRange Range("A500:IL1000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Range("AL500").Select
ActiveCell.FormulaR1C1 = "1"
Range("AL501").Select
ActiveCell.FormulaR1C1 = "2"
Range("AL500:AL501").Select
Selection.AutoFill Destination:=Range("AL500:AL1000"), Type:=xlFillDefault
Range("AL500:AL1000").Select
ActiveWindow.SmallScroll Down:=-3
Range("D500:D1000").Select
Selection.NumberFormat = "m/d/yyyy"
Range("E500").Select
Rows("500:1000").Select
ActiveWorkbook.Worksheets("Archivio clienti").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Archivio clienti").Sort.SortFields.Add Key:=Range( _
"A500:A1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Archivio clienti").Sort.SortFields.Add Key:=Range( _
"D500:D1000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Archivio clienti").Sort
.SetRange Range("A500:IL1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
borile500
Utente Junior
 
Post: 14
Iscritto il: 25/08/09 11:36

Re: MACRO e FILTRO

Postdi Flash30005 » 30/08/09 10:38

Un esempio vale più di mille parole
ti invio il file che a me non dà errori
scrivi in A7
tiziotizio
e otterrai il risultato dalla riga A8 in poi
http://rapidshare.com/files/273343845/CopiaFiltro.zip.html

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: MACRO e FILTRO

Postdi borile500 » 30/08/09 19:00

Grazie mille!!!!!!!! Son riuscito ad adattarlo al mio programma :) :) :)
Geniale, al punto che inizialmente nn ci avevo capito nulla :D
borile500
Utente Junior
 
Post: 14
Iscritto il: 25/08/09 11:36


Torna a Applicazioni Office Windows


Topic correlati a "MACRO e FILTRO":


Chi c’è in linea

Visitano il forum: Ricky0185 e 40 ospiti