Confrontare date e copiare celle

Hai un problema con Excel?

Nuova discussione

Confrontare date e copiare celle
di Corrado (utente non iscritto) data: 21/12/2016 13:21:13
Buongiorno a tutto il forum,
Chiedo il vostro aiuto per risolvere un problema.
Premetto che non conosco il VB per Excel ma ho provato a scrivere lo stesso il codice.
Il problema da risolvere è il seguente.
Dopo aver confrontato la 1° data presente nel foglio 2 con la 1° data nel foglio 1, preleva i contenuti nelle colonne C e G del foglio 2 e li copia rispettivamente nelle colonne C ed E del foglio 1 rispettando l’ordinamento crescente stabilito dalle date. Poi passa alle altre date del foglio 2 fino alla fine.

Es.
Questi i dati del foglio 1
C D E
2 19/08/16 -10
3 19/09/16 -100
4 19/10/16 80
5 19/11/16 -50
6 19/11/16 120

Questi i dati del foglio 2
C D E F G
6 18/08/16 340
7 21/08/16 -150
8 20/10/16 80
9 16/11/16 -50
10 19/11/16 120
Quindi, dopo aver confrontato la data 1° data del foglio2 (18/08/16) con la 1° data del foglio1 (19/08/16) vorrei copiare le celle C6 e G6 del foglio 2 ed inserirle nel foglio 1 nelle celle C2 ed E2 dopo aver spostato in basso di una riga tutto il contenuto del foglio 1. Spero di essere stato chiaro.

Sub ORDINI_TS()
'
' ORDINI_TS Macro
'
Dim i As Long, j As Long
Dim valAB As Long
Dim F1 As String, F2 As String

F1 = Sheets(1).Name
F2 = Sheets(3).Name

' Il contatore "i" serve per selezionare gli ordini del foglio2
For i = 6 To 10
' Il contatore "j" serve per confrontare gli ordini gli ordini del foglio1
      For j = 2 To 6 + i 
      ' valAB = Sheets(F1).Cells(1, i)
       If Sheets(F3).Cells(i, 3) <= Sheets(F1).Cells(j, 3) Then
          Sheets(F1).Activate
          ActiveSheet.Range("J:J").Select
          Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
          Sheets(F3).Activate
          ActiveSheet.Range(Cells(i, 3)).Select
          Selection.Copy
          Sheets(F1).Activate
          ActiveSheet.Cells(j, 3).Select
          ActiveSheet.Paste
          Sheets(F3).Activate
          ActiveSheet.Range(Cells(i, 7)).Select
          Selection.Copy
          Sheets(F1).Activate
          ActiveSheet.Cells(j, 5).Select
          ActiveSheet.Paste
        End If
           
        If Sheets(F3).Cells(i, 3) > Sheets(F1).Cells(j, 3) Then
          Sheets(F1).Activate
          ActiveSheet.Range("J+1:J+1").Select
          Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
          Sheets(F3).Activate
          ActiveSheet.Range(Cells(i, 3)).Select
          Selection.Copy
          Sheets(F1).Activate
          ActiveSheet.Cells(j, 3).Select
          ActiveSheet.Paste
          Sheets(F3).Activate
          ActiveSheet.Range(Cells(i, 7)).Select
          Selection.Copy
          Sheets(F1).Activate
          ActiveSheet.Cells(j, 5).Select
          ActiveSheet.Paste
        End If
    Next j
Next i

End Sub

di Mister_x (utente non iscritto) data: 21/12/2016 14:51:45
ciao

sarebbe utile avere a disposizione il tuo file ,per non ricreare tutto ex novo ed evitare errori di ricerca e inserimento

ciao
di Corrado (utente non iscritto) data: 21/12/2016 14:59:07
Come si allegano i files?
di alfrimpa data: 21/12/2016 15:07:14
Eppure i pulsanti sono belli grossi

Li trovi in alto e in basso a destra

Alfredo
di Corrado (utente non iscritto) data: 21/12/2016 15:24:45
Si, ma quando clicco su nuova risposta scompaiono.
Comunque adesso credo di averlo allegato.

di Mister_x (utente non iscritto) data: 21/12/2016 16:01:09
ciao

la sub che ti propongo e' quanto ti posso scrivere senza stravolgere le tue
questa si intende per farti capire un pochino il meccanismo del VBA
si intende che questo e' solo un esempio ,in quanto sarebbe migliorabile nel suo interno
come vedi ho eliminato tutto dalla tua , prendendo in considerazione il foglio1 come principale e il foglio tre solamente in lettora senza utilizzare copy ne paste

ciao

Sub CopiaDa_F3_a_F1()
Dim i As Long, j As Long
Dim valD_F1 As Long
Dim F1 As String, F2 As String
F1 = Sheets(1).Name
F3 = Sheets(3).Name
For i = 2 To Sheets(F1).Cells(Rows.Count, "C").End(xlUp).Row
  valD_F1 = Sheets(F1).Cells(i, "C")
  For j = 6 To Sheets(F3).Cells(Rows.Count, "C").End(xlUp).Row
    If valD_F1 = Sheets(F3).Cells(j, "C") Then
      Sheets(F1).Cells(i, "E") = Sheets(F3).Cells(j, "G")
      Exit For
    End If
  Next j
Next i
End Sub

di Corrado (utente non iscritto) data: 21/12/2016 16:27:52
Innanzi tutto grazie della risposta, però non funziona.
Quando la subroutine viene eseguita correttamente io nel foglio 1 dovrei ritrovare tutti i valori contenuti sia nel fogli 1 che nel foglio 2 ordinati per data.
di Mister_x (utente non iscritto) data: 21/12/2016 16:55:30
ciao

come fai a definire delle date tra foglio1 e foglio3 quando tra il foglio1 e il foglio3 l'unica che combacia e' la data del 19/11/16
o forse tu intendi riportare i valori annessi alle date da foglio3 pari pari in scala a foglio1???
altra cosa le date in foglio1 da che cosa vengono scaturite ??? in quanto non riesco a capire il nesso della posizione

ciao
di Corrado (utente non iscritto) data: 21/12/2016 19:59:32
Ho cercato di semplificare il problema. Nelle colonne A, B, D, F ecc. del foglio1 ci sono altri valori. Ovviamente anche nelle colonne del foglio3 ci sono altri valori. Ho mostrato soltanto l'esatta disposizione dei dati che mi interessano dei fogli 1 e 3 che ovviamente sono più di 5 righe a foglio.
Comunque, spero di fugare ogni dubbio con il nuovo file allegato "ORDINI TS 2" dove nel foglio 2 ho riportato quello che vorrei ottenere con la macro. Ho evidenziati in giallo i dati del foglio 3.

di Mister_x (utente non iscritto) data: 22/12/2016 01:03:48
ciao

in base al tuo ultimo file e con dati in foglio2 , un principio di ragionamento puo essere questo
vedi sub() allegata

ciao

Sub Insert_F3_a_F1()
Dim i As Long, j As Long
Dim valD_F3 As Long
Dim F1 As String, F2 As String
F1 = Sheets(1).Name
F3 = Sheets(3).Name
For i = 6 To Sheets(F3).Cells(Rows.Count, "C").End(xlUp).Row Step 2
  valD_F3 = Sheets(F3).Cells(i, "C")
  For j = 2 To Sheets(F1).Cells(Rows.Count, "C").End(xlUp).Row
    If valD_F3 <= Sheets(F1).Cells(j, "C") Then
    Sheets(F1).Range(j & ":" & j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      Sheets(F1).Cells(j, "C") = Sheets(F3).Cells(i, "C")
      Sheets(F1).Cells(j, "E") = Sheets(F3).Cells(i, "G")
      Exit For
    End If
  Next j
Next i
End Sub

di Corrado (utente non iscritto) data: 22/12/2016 09:54:32
Funziona! Grazie mille!!!
Però adesso vorrei capire come cambiare il numero di righe da ordinare in entrambi i fogli. Sicuramente, devo intervenire su "Rows.count" che però non è un numero. L'istruzione applica automaticamente il codice sulle celle non vuote delle colonne C?
di patel data: 22/12/2016 11:54:25
L'istruzione applica automaticamente il codice sulle celle non vuote delle colonne C? - esatto
se non ti va bene devi fare una cosa del genere
rigafine = 23 For i = 6 To rigafine Step 2
di Corrado (utente non iscritto) data: 23/12/2016 09:29:10
Immaginavo, ho chiesto per cercare di capire.
Grazie di nuovo e auguri di Buone Feste!

Vuoi Approfondire?