sonoilbiondo
Monday, December 24, 2012 11:35 PM
Ciao a tutti,
auguri a tutti!
Avrei bisogno di un aiuto per risolvere un problema sorto nel creare una macro in VBA del tipo:

a) Gli n elementi in colonna A del Dati1 dovranno essere confrontati con gli m elementi della colonna B del Dati2.
b) Se l'elemento della colonna A del Dati1 è presente nella colonna B del Dati2 allora:
- colora di verde la cella di A del Dati1;
- copia in Dati1, nella corrispondente riga (dell'elemento trovato) ma in colonna D, il valore della colonna C del Dati2 (dell'elemento trovato).


Ho scritto la macro che segue in allegato ma non riesco ad individuare l'errore:

Sub evidenzia_e_copia()

Dim ultimariga As Integer, i As Integer
i = 2


Worksheets("Dati1").ActiveSheet.Range("A:A").ClearFormats

ultimariga = Worksheets("Dati1").Range("A" & Rows.Count).End(xlUp).Row

For Each cella In Worksheets("Dati1").Range("A2:A" & ultimariga)
With Worksheets("Dati2").ActiveSheet.Range("B:B")
Set Rng = .Find(What:=cella, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not Rng Is Nothing Then
cella.Interior.ColorIndex = 4
Worksheets("Dati1").Range("D" & i).Value = Worksheets("Dati2").Range("C" & i).Value

End If
End With
i = i + 1

Next cella

End Sub


Grazie a tutti per l'aiuto.
patel45
Tuesday, December 25, 2012 9:09 AM
Devi eliminare ActiveSheet che puoi usare con un oggetto workbook, ma non con un worksheet, non esiste un foglio attivo appartenente ad un foglio, ma esiste un foglio attivo appartenente ad un workbook.
Sub evidenzia_e_copia()
Dim ultimariga As Integer, i As Integer
i = 2
Worksheets(1).Range("A:A").ClearFormats
ultimariga = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
For Each cella In Worksheets(1).Range("A2:A" & ultimariga)
  With Worksheets(2).Range("B:B")
    Set Rng = .Find(What:=cella, _
    After:=.Cells(.Cells.Count), _
    LookIn:=xlFormulas, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext)
    If Not Rng Is Nothing Then
       cella.Interior.ColorIndex = 4
       Worksheets(1).Range("D" & i).Value = Worksheets(2).Range("C" & i).Value
    End If
  End With
  i = i + 1
Next cella
End Sub

sonoilbiondo
Tuesday, December 25, 2012 6:04 PM
Grazie tante, ora la macro gira senza errori.

In pratica ora che vedo eseguirla, però, mi copia la nota corrispondente all'indice "i" (del foglio Dati1) e non quella di Dati2 [SM=x423023]

Se volessi copiare in Dati1, nella corrispondente riga (dell'elemento trovato) ma in colonna D, il valore note della colonna C del foglio Dati2 (dell'elemento trovato), come posso inserire un indice "j" che mi aiuti nell'intento?


Ho fatto un po di prove ma senza risultati positivi [SM=x423040]

Grazie.
patel45
Tuesday, December 25, 2012 6:55 PM
allega il file con anche il risultato desiderato
sonoilbiondo
Tuesday, December 25, 2012 8:07 PM
In colonna H, del foglio Dati1, ho inserito manualmente il risultato desiderato.
In colonna D, del foglio Dati1 invece, c'è il risultato errato ottenuto dalla macro.

Grazie.
patel45
Wednesday, December 26, 2012 5:59 AM
Sub evidenzia_e_copia()
Dim ultimariga As Integer, i As Integer, cella As Range, Rng As Range
i = 2
Worksheets("Dati1").Range("A:A").ClearFormats
ultimariga = Worksheets("Dati1").Range("A" & Rows.Count).End(xlUp).Row
For Each cella In Worksheets("Dati1").Range("A2:A" & ultimariga)
   With Worksheets("Dati2").Range("B:B")
      Set Rng = .Find(What:=cella, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext)
      If Not Rng Is Nothing Then
        cella.Interior.ColorIndex = 4
        cella.Offset(0, 2).Value = Rng.Offset(0, 1).Value
      End If
   End With
Next cella
End Sub

sonoilbiondo
Wednesday, December 26, 2012 1:10 PM
Grazie tante, funziona benissimo [SM=x423025]
Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa click here
Tutti gli orari sono GMT+01:00. Adesso sono le 12:26 PM.
Copyright © 2000-2014 FreeForumZone snc - www.freeforumzone.com