Paragone foglio ed estrazione info

Hai un problema con Excel?

Nuova discussione

Paragone foglio ed estrazione info
di JacMo (utente non iscritto) data: 27/07/2015 09:55:31
Ciao a tutti,
volevo chiedere aiuto per una macro che deve girare su un file di excel composto da tre fogli.
Il foglio 1 contiene una grande quantità di dati di cui me ne interessano solo alcuni; il foglio 2 contiene una lista ristretta di nomi, che possono essere presenti anche nel foglio 1.
Quello che devo fare è creare una macro in grado di:

leggere la casella A1 del foglio 2;
paragonare questa casella a quella J3 del foglio1;
se il contenuto è identico, copiare l'intera riga 3 del foglio 1 nella riga 1 del foglio 3; se il contenuto non è identico, passare alla cella A2 del foglio 2 e rifare il confronto con la cella J3 del foglio1 (in modo da arrivare alla fine dell'elenco contenuto nella colonna A del foglio 2).

una volta finito questo primo ciclo, il tutto dovrebbe ripetersi per la casella J4, J5, ecc fino ad arrivare alla fine del foglio 1

Il risultato dovrebbe essere un foglio (foglio 3) contenente un sottoinsieme del foglio 1

Grazie tantissimo

Jac
di Vecchio Frac data: 27/07/2015 10:54:32
E' chiarissimo, dettagliato e descrive i passi che ti servono.
Cos'è che non ti riesce di realizzare? sei bloccato da qualche parte o non conosci VBA per cui partiresti da zero? in questo secondo caso è meglio che ci pensi prima di partire perchè se poi non sei capace di manutenere il codice, o se poi ti serve aggiungere qualche funzione o adattare il codice per altri scopi, ti troverai in difficoltà.
di JacMo (utente non iscritto) data: 27/07/2015 11:00:45
Al momento ho scritto qualcosa di funzionante (perchè avevo seguito molti anni fa un corso di vba), solo che al momento sono bloccato...quello che ho scritto è questo:

Sub Macro2()
' Macro2 Macro
Set WS1 = Sheets("Effect (Combined)")
Set WS2 = Sheets("Foglio1")
Set WS3 = Sheets("Foglio2")
For x = 2 To 500
For y = 0 To 20
WS2.Select
WS2.Cells(y + 1, 1).Select
If WS2.Cells(y + 1, 1) = WS1.Cells(x + 1, 10) Then
WS1.Select
Rows("3").Select
Selection.Copy
WS3.Select
Rows("3").Select
ActiveSheet.Paste
Rows("3").Offset(1, 0).Select
End If
Next
Next
End Sub

Solo che non riesco a fare funzionare i cicli in modo da scorrere correttamente entrambi i fogli...
di Vecchio Frac data: 27/07/2015 11:57:43
Un giorno mi specializzerò in arte dell'uso delle tenaglie :)
Fai una cortesia, non costringermi a costruire da me uno scenario attendibile per provare il tuo codice, verificare che problemi ha e inventare una soluzione approssimativa.
Allega un file di esempio corredato del risultato atteso.
Altrimenti andiamo avanti due giorni a pizzichi e bocconi con mezze informazioni e totali incomprensioni.

p.s. tutti quei Select si possono evitare dato che generalmente non si deve pre-selezionare un intervallo per farci qualche cosa.
di JacMo (utente non iscritto) data: 27/07/2015 12:09:57
ecco il file…nel foglio "Effect (Combined)" ci sono I dati originali…adesso sono solo 100 ma in realtà sono molti di più…
nel foglio 1 ci sono un elenco che importo io
nel foglio 2 (quello che dovrebbe uscire in automatico) ci sono le righe copiate dal foglio "Effect (Combined)" relative all'elenco presente nel foglio 1 (foglio 1 colonna A vs foglio "Effect (Combined)"colonna J) a partire dalla riga 3 perché nelle prime due righe ci dovrebbe essere la stessa intestazione del foglio "Effect (Combined)"

spero che sia chiaro...per adesso GRAZIE!!!!

di cromagno data: 27/07/2015 21:09:58
Ciao JacMo
prova se questo funziona...

Sub elenca()
Dim riga As Integer
Dim WS1, WS2, WS3 As Worksheet
Set WS1 = ThisWorkbook.Sheets(1)
Set WS2 = ThisWorkbook.Worksheets("Foglio1")
Set WS3 = ThisWorkbook.Worksheets("Foglio2")
riga = 3
    For y = 3 To 500
        For x = 1 To 19
            If WS2.Cells(x, 1).Value = WS1.Cells(y, 10).Value Then
                WS1.Activate
                ActiveSheet.Rows(y).EntireRow.Select
                Selection.Copy
                WS3.Activate
                Cells(riga, 1).Select
                ActiveSheet.Paste
                riga = riga + 1
            End If
        Next x
    Next y
Range("A3").Select
WS1.Activate
Application.CutCopyMode = False
Range("A3").Select
End Sub

di Raffaele_53 data: 27/07/2015 22:07:05
Ciao cromagno,
a parte che se in foglio2 ci sono due/tre volte lo stesso nome. Il risultato sarà con righe doppie/triple (l'utente dovrebbe spiegare meglio cosa desidera)

Comunque personalmente metterei il codice in un modulo e scriverei ...

' Meglio se inserito in un modulo
Option Explicit
Sub elenca2()
Dim Ur1 As Long, Ur2 As Long, Y As Long, X As Long, riga As Long ' meglio Long che Integer
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet 'non Dim WS1, WS2, WS3 As Worksheet
Set WS1 = ThisWorkbook.Sheets("Effect (Combined)")
Set WS2 = ThisWorkbook.Worksheets("Foglio1")
Set WS3 = ThisWorkbook.Worksheets("Foglio2")
'oppure Dim WS1 As Worksheet: Set WS1 = Worksheets("Effect (Combined)") ' altre righe per WS2 + WS3
Application.ScreenUpdating = False ' sarebbe meglio
Ur1 = WS1.Range("A" & Rows.Count).End(xlUp).Row ' l'utente parla di molti record
Ur2 = WS2.Range("A" & Rows.Count).End(xlUp).Row
riga = 3
        For Y = 3 To Ur1
            For X = 1 To Ur2
                If WS2.Cells(X, 1).Value = WS1.Cells(Y, 10).Value Then
                    WS1.Rows(Y).EntireRow.Copy
                    WS3.Cells(riga, 1).PasteSpecial
                    riga = riga + 1
                End If
            Next X
        Next Y
    WS3.Select
    WS3.Range("A3").Activate
Set WS1 = Nothing 'distruggo l'oggetto
Set WS2 = Nothing 'distruggo l'oggetto
Set WS3 = Nothing 'distruggo l'oggetto
Application.ScreenUpdating = True ' ripristino lo stato
Application.CutCopyMode = False
End Sub

di cromagno data: 27/07/2015 22:44:35
Ciao Raffaele,
come sai sono agli inizi con VBA e mi butto a pesce su ogni codice (fattibile per me) per esercitarmi, quindi ben vengano le vostre correzioni, le aspetto con ansia

Ciao

Vuoi Approfondire?