[Excel] trova primo per ogni giorno

[macio66]

Buongiorno a tutti
Vorrei sapere se è possibile creare una macro che, da uno scarico dati (foglio1), dove:
colonna A=data
colonna B=ora
colonna C=Serial Number
Colonna D=Si o No
per ogni data presente, mi deve trovare il primo Serial Number che soddisfi il valore della colonna D (si).
Nello scarico il numero di date non è mai eguale e anche il numero di righe presenti varia di volta in volta.
I vari risultati dovrebbero comparire incolonnati per ordine di data nel foglio2.
Grazie

[ricky53]

Ciao,
mi è poco chiaro cosa ti occorre.

Puoi chiarire la seguente frase

... trovare il primo Serial Number che soddisfi il valore della colonna D (si).

[macio66]

Ciao,
Di ogni giorno, mi dovrebbe cercare il primo Serial Number in ordine di ora (crescente), in cui, nella colonna D ci sia si
esempio :
Colonna A Colonna B Colonna C Colonna D
1 13/07/2014 9.00 pippo no
2 13/07/2014 9.15 pluto no
3 13/07/2014 9.35 paperino si
4 13/07/2014 9.50 topolino si
5 14/072014 8.00 topolino no
6 14/07/2014 8.20 pluto si
7 17/07/2014 9.15 pippo si
In questo esempio mi dovrebbe prelevare la riga 3 e 6 e riportarle nel foglio2.
Spero di essermi spiegato
Ciao

[macio66]

Ciao
Anche la riga 7 è da prelevare e riportarla nel foglio2

[ricky53]

Ciao,
prova il seguente codice:

Codice: Seleziona tutto

Option Explicit
Option Compare Text

Sub Elabora()
    Dim I As Long, J As Long, UR As Long, Copiati As Integer
    Sheets("Foglio1").Select
    Application.ScreenUpdating = False
    UR = Range("A" & Rows.Count).End(xlUp).Row
    J = Sheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Foglio2").Range("A2:D" & J).ClearContents
    J = 2
    Copiati = 0
    For I = 2 To UR
        If Cells(I, "D") = "SI" Then
            If I = UR And Cells(I, "A") <> Cells(I - 1, "A") Or Cells(I, "A") = Cells(I + 1, "A") Or Cells(I, "A") <> Cells(I - 1, "A") Then
                Range("A" & I & ":D" & I).Copy Destination:=Sheets("Foglio2").Cells(J, "A")
                Copiati = Copiati + 1
                J = J + 1
            End If
        End If
    Next I
    Application.ScreenUpdating = True
    MsgBox "Elaborazione effettuata. Sono stati copiati i dati di  " & Copiati & "  righe", vbInformation
End Sub

ATTENZIONE: I dati del "Foglio2" vengono CANCELLATI
Se vuoi accodare allora occorre fare due modifiche al codice sostituendo

Codice: Seleziona tutto

    J = Sheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Foglio2").Range("A2:D" & J).ClearContents
    J = 2


con

Codice: Seleziona tutto

    J = Sheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row + 1


Prova e ...


Se i dati da copiare sono tanti allora occorre introdurre l'utilizzo delle "ARRAY" !
Tu quanti dati prevedi di dover copiare?

[macio66]

Ciao ricky53,
Innanzitutto grazie per il tuo aiuto.
Ho provato il codice che mi hai dato, ma il risultato non è quello che mi aspettavo in quanto di alcune date mi copia più dati, mentre di altre date non mi copia nessuna riga.
Questo è l'esempio provato:

Data - Ora - Serial Number - TT
12-lug-14 - 8,00 - A - NO
12-lug-14 - 8,30 - B - NO
12-lug-14 - 8,45 - C - SI
13-lug-14 - 9,00 - A - NO
13-lug-14 - 9,15 - B - SI
13-lug-14 - 9,20 - C - NO
13-lug-14 - 10,00 - D - SI
14-lug-14 - 8,00 - A - NO
14-lug-14 - 9,00 - B - NO
14-lug-14 - 9,15 - C - SI
15-lug-14 - 10,00 - A - SI
15-lug-14 - 10,30 - B - NO
15-lug-14 - 11,00 - C - SI
15-lug-14 - 12,00 - D - SI
15-lug-14 - 13,00 - E - NO
16-lug-14 - 9,00 - A - NO
16-lug-14 - 10,00 - B - NO
16-lug-14 - 11,00 - C - SI
17-lug-14 - 8,00 - A - NO
17-lug-14 - 9,00 - B - SI
17-lug-14 - 10,00 - C - SI
17-lug-14 - 10,30 - D - NO

e questo è il risultato ottenuto:

13-lug-14 - 9,15 - B - SI
15-lug-14 - 10,00 - A - SI
15-lug-14 - 11,00 - C - SI
15-lug-14 - 12,00 - D - SI
17-lug-14 - 9,00 - B - SI
17-lug-14 - 10,00 - C - SI

Come vedi del giorno 14/7 e 16/7 non mi ha dato nessun risultato, mentre del giorno 15/7 e 17/7 mi ha dato più risultati di quelli voluti.
Non capisco il perchè.
Ciao

[macio66]

Ciao ricky53,
Anche del giorno 12/7 non mi ha dato nessun risultato.
(scusami per la mia imprecisione)

[macio66]

Ciao ricky53,
Il risultato che invece mi sarei aspettato era il seguente:

12-lug-14 - 8,45 - C - SI
13-lug-14 - 9,15 - B - SI
14-lug-14 - 9,15 - C - SI
15-lug-14 - 10,00 - A - SI
16-lug-14 - 11,00 - C - SI
17-lug-14 - 9,00 - B - SI

[ninai]

ciao
una proposta alternativa , con formule:
Con VBA, è sicuramente meglio.
esempio:
i tuoi dati in A2:D23

in F2:
=SE.ERRORE(INDICE(A$2:A$23;CONFRONTA(0;INDICE(CONTA.SE($F$1:$F1;$A$2:$A$23)+($D$2:$D$23="no"););0));"")

trascini a destra ed in basso
(la colonna G, in formato ora)

NB
si presuppone che i dati siano ordinati per data e ora

[ricky53]

Ciao,
nella mia precedente proposta non avevo considerato tutte le possibilità.

Prova quest'altra proposta

Codice: Seleziona tutto

Option Explicit
Option Compare Text

Sub Elabora()
    Dim I As Long, J As Long, UR As Long, Riga As Long, Copiati As Integer, Intervallo As Range
    Dim WS1 As Worksheet, WS2 As Worksheet
   
    Set WS1 = Sheets("Foglio1")
    Set WS2 = Sheets("Foglio2")
    Application.ScreenUpdating = False
    UR = WS1.Range("A" & Rows.Count).End(xlUp).Row
    J = WS2.Range("A" & Rows.Count).End(xlUp).Row
    WS2.Range("A2:D" & J).ClearContents
    J = 2
    Copiati = 0
    For I = 2 To UR
        If WS1.Cells(I, "D") = "SI" Then
            Set Intervallo = WS2.Range("A2:A" & J)
            If Application.CountIf(Intervallo, WS1.Cells(I, "A")) = 0 Then
                WS1.Range("A" & I & ":D" & I).Copy Destination:=WS2.Cells(J, "A")
                Copiati = Copiati + 1
                J = J + 1
            End If
        End If
    Next I
    Application.ScreenUpdating = True
    MsgBox "Elaborazione effettuata. Sono stati copiati i dati di  " & Copiati & "  righe", vbInformation
End Sub

[macio66]

Ciao ricky53,
adesso è perfetto, come al solito non posso che ringraziarvi del vostro prezioso aiuto e della vostra disponibilità.
Grazie e alla prossima

[ricky53]

Ciao,
BENE!

Hai provato la soluzione proposta da Ninai?
Può essere utile provare altre soluzioni ... e poi si impara sempre qualcosa.

A proposito di imparare: sai leggere ed interpretare il codice che ti ho inviato?
Se non ti muovi con facilità con il VBA vale la pena di iniziare.

[macio66]

Ciao ricky53,
A leggere il codice e interpretarlo una volta fatto, diciamo che me la cavicchio, se invece devo partire da zero non sempre riesco a cavarmela,ma se tu puoi consigliarmi un manuale VBA che mi possa aiutare a creare i codici, te ne sarei grato.
Per quanto riguarda la soluzione proposta da ninai, la proverò sicuramente per vedere come funziona

[ricky53]

Ciao,
manuali non saprei perchè non li ho utilizzati però in rete potrai trovare diversi siti che mettono a disposizione dei corsi/lezioni sul VBA veramente utili che partono delle cose elementari e vanno avanti.