VBA Macro Excel: trovare voce corrispondente in colonna e sostituire dati in altra colonna.

di Anonimizzato29561 il
7 risposte
Buongiorno,
Ho 2 tabelle in fogli Excel distinti: "ARTICOLI" ed "ANALISI".
Vorrei una macro (vba) associata ad un pulsante (posto nel foglio "ANALISI") per compiere il seguente aggiornamento.
1) cercare nella colonna D del foglio "ANALISI" il CODICE: "MAT.00"
2) leggere nella colonna B del foglio "ANALISI" l'ARTICOLO corrispondente
3) cercare nella colonna B del foglio "ARTICOLI" l'articolo appena letto al punto 2 e salvare il valore corrispondete della colonna M
(Nota: la tabella ARTICOLI ha l'ARTICOLO unico, non esistono duplicati)
4) il valore appena salvato al punto 3 deve sostituire il valore contenuto nella colonna G del foglio "ANALISI" alla riga del punto 1.
5) Compiere la stessa operazione per i successivi "MAT.00" in tabella fino alla fine della stessa.

Foglio ANALISI:
Colonna B - Colonna D - Colonna G
ART.01 - MAT.00 - Valore da sostituire
ART.01 - Altro codice - Invariato
ART.02 - MAT.00 - Valore da sostituire
ART.02 - Altro codice - Invariato

Foglio ARTICOLI:
Colonna B - Colonna M
ART.01 - Valore da copiare
ART.02 - Valore da copiare

Potete aiutarmi?

7 Risposte

  • Prova con questa mia macro da mettere in un modulo standard ed associarla ad un pulsante e vedi se soddisfa la tua richiesta altrimenti puoi sempre utilizzarla come base di partenza ed adattarla al tuo progetto (che io non posso valutare per bene dato che non hai allegato un file esempio).Ho anche presunto che in riga 1 vi siano dei titoli.
    Option Explicit
    Sub Cerca_Riporta()
    
        Dim sh1    As Worksheet
        Dim sh2    As Worksheet
        Dim matr   As String
        Dim rng1   As Range
        Dim rng2   As Range
        Dim cella  As Range
        Dim art1   As Range
        Dim art2   As Range
        Dim trova  As Boolean
    
        Set sh1 = Sheets("ARTICOLI")
        Set sh2 = Sheets("ANALISI")
        matr = InputBox("Matricola da cercare ?", Title:="Ricerca ...")
        If matr = "" Then
            MsgBox "Nessuna matricola da cercare", vbExclamation
            Exit Sub
        End If
            Application.ScreenUpdating = False
        Set rng1 = sh1.Range("B2:B" & sh1.Range("B" & sh1.Rows.Count).End(xlUp).Row)
        Set rng2 = sh2.Range("D2:D" & sh2.Range("D" & sh2.Rows.Count).End(xlUp).Row)
        For Each cella In rng2
            If UCase(cella) = UCase(matr) Then        'confrontali in maiuscolo
                Set art2 = cella.Offset(0, -2)
                Set art1 = rng1.Find(art2, LookIn:=xlValues, LookAt:=xlWhole)
                art1.Offset(0, 11).Copy cella.Offset(0, 3)
                trova = True
            End If
        Next cella
        If trova = False Then MsgBox "Matricola non trovata"
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        
    End Sub
  • Grazie per la risposta tempestiva!
    Sto analizzando il tuo suggerimento.
    Ho notato che però non viene riportato nel foglio ANALISI il valore preso da ARTICOLI ma l'intera formula che però in ANALISI dà zero.
  • Infatti, questo è quello che avevo scritto:
    utilizzarla come base di partenza ed adattarla al tuo progetto (che io non posso valutare per bene dato che non hai allegato un file esempio)
    e considerato che non hai fatto cenno ad eventuale presenza di formule questa è la riga dove devi intervenire:
    art1.Offset(0, 11).Copy cella.Offset(0, 3)
    Nella seconda parte (destinazione) devi applicare un Incolla Valori invece dell'attuale semplice e diretto incolla.
  • Come si fa? Ciò provato ma senza successo!
  • Sostituisci la riga che ti ho indicato separando la fonte dalla destinazione ed applicando l'Incolla Valori:
    art1.Offset(0, 11).Copy
    cella.Offset(0, 3).PasteSpecial xlPasteValues
  • Funziona perfettamente! Grazie Mille!
    Adesso mi studio bene tutti i passaggi,
    Grazie
  • Grazie del riscontro positivo
Devi accedere o registrarti per scrivere nel forum
7 risposte