-
Articoli
-
Ciao a tutti, come al solito mi trovo nella solita empasse di principiante , ovvero in colonna A ho un elenco casuale che poi riprendo in una cella mediante una scelta a convalida , fatta questa scelta per es. PROG2 in colonna B dovrei selezionare tutte le occorrenza che hanno in colonna A il Prog.2 ,e le devo riportare in sequenza una sotto l'atra in colonna F a partire da F19. Allego immagine cosi si capisce . Ora con la macro che riporto ottengo solo l'ultimo dei valori di mio interesse , NERO , tutti gli altri li ha sovrascritti, mentre nella finestra immediata risultano tutti correttamente . In pratica manca il riferimento per il cambio riga . Banale, ma è tutto il pomeriggio che ci sbatto la capa . Se qualcuno mi illumina ...
Grazie 
`Option Explicit Sub CreaElncoDaSelezione2() Dim rng As Range Dim cell As Range Dim cella_iniziale As Range Dim Lr As Long Dim C Dim firstAddress As String ' intervallo di origine della ricerca Set rng = Range("A2:A14") Set cella_iniziale = Range("F19") Range("F18") = "DEFINIZIONI" Lr = Cells(Rows.Count, 6).End(xlUp).Row + 1 Range("F19:F" & Lr).Clear With Worksheets("Foglio2").Range("A2:A" & Lr) Dim X As String X = Cells(17, 5).Value ' stringa da cercare in E17 Set C = .Find(X, LookIn:=xlValues, LookAt:=xlWhole) If Not C Is Nothing Then firstAddress = C.Address Do C.Cells.Offset(0, 1).Copy cella_iniziale.PasteSpecial Debug.Print cella_iniziale Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> firstAddress Else MsgBox "Nome non Trovato" End If End With End Sub `Ciao, volendo restare nel tuo codice...opterei per aggiungere questa riga di codice prima del Loop While:
Set cella_iniziale = cella_iniziale.Offset(1)In pratica ad ogni nuovo ciclo, sposti alla riga sotto la variabile cella_iniziale
In realtà potresti anche fare a meno della variabile di tipo Range cella_iniziale ed utilizzare al suo posto una di tipo Long (magari la chiami riga) e quando devi incollare il dato copiato, lo incollerai così:
If Not C Is Nothing Then riga = 19 firstAddress = C.Address Do C.Cells.Offset(0, 1).Copy Cells(riga, "F").PasteSpecial riga = riga + 1 Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> firstAddress ..... ..... .....Addirittura si può fare a meno anche del ciclo Do/Loop While e sfruttare il Filtro sulla Tabella ed incollare i valori visibili:
Sub CreaElencoDaSelezione_3() 'senza ciclo Dim progetto As String Dim ur As Long Dim lo As ListObject Dim rng As Range Application.ScreenUpdating = False Set lo = Foglio2.ListObjects(1) progetto = Range("E17").Value Range("F18").Value = "DEFINIZIONI" ur = Cells(Rows.Count, "F").End(xlUp).Row If ur > 18 Then Range("F19:F" & ur).ClearContents With lo .ShowAutoFilterDropDown = True .Range.AutoFilter Field:=1, Criteria1:=progetto Set rng = .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible) rng.Copy Range("F19").PasteSpecial xlPasteValues .Range.AutoFilter Field:=1 .ShowAutoFilterDropDown = False End With Application.CutCopyMode = False Application.ScreenUpdating = True End SubGrazie ai tuoi suggerimenti ho risolto l'empasse in cui ero finito, ma soprattutto ho capito dove sbagliavo .
Non sono invece riuscito a provare la versione (3) con filtro mi dà errore qui :
Set lo = Foglio2.ListObjects(1)errore 424 manca oggetto ?
Non sono invece riuscito a provare la versione (3) con filtro mi dà errore qui :
Set lo = Foglio2.ListObjects(1)errore 424 manca oggetto ?
Ma l'elenco che hai in "A1:B14" appartiene ad una ListObject? (A me così sembra).
Il codeName del foglio è Foglio2? Se effettivamente quella in "A1:B14" è una tabella ListObject, allora il problema può risiedere nel codeName del Foglio. Prova a modificare quello.
Si, hai ragione,
era foglio1 denominato foglio2 nella linguetta, corretto , tutto OK.
Login
Registrati
Stai vedendo 5 articoli - dal 1 a 5 (di 5 totali)
Stai vedendo 5 articoli - dal 1 a 5 (di 5 totali)