Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Creazione valore Criterio Filtro

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Creazione valore Criterio Filtro

Postdi oz85 » 07/06/18 11:13

Mega problema.... molto complesso che cercherò di spiegare bene.

Mi ritrovo ad avere una tabella che contiene dei cavi che devo tagliare. Ogni cavo ha due estremità che hanno il nome di PARTENZA e ARRIVO che sono ad indicare su quale riferimento li devo montare.

Questi cavi però possono essere singole, doppie, triple, etc etc. Questo perchè un cavo può essere unito con altri. Ho creato una tabella dinamica che in base a dei pulsanti cliccati, mi fa visualizzare quello che mi occorre.
Per i cavi che sono singole non ho problemi, mentre invece nasce il problema di visualizzare i cavi che sono doppie e/o superiori, perchè dovrei creare un criterio di filtro che accomuni il tutto.

Sotto un esempio scritto di come ho i dati.

PARTENZA ARRIVO
RIGA 1: X153/Va → X152/E8_85
RIGA 2: X152/E7_85 → X152/E8_85
RIGA 3: X152/E7_85 → X152/E6_85

Come vedete, le tre righe sono unite dal fatto che la RIGA 1 e 2 hanno lo stesso ARRIVO e due PARTENZE differenti, mentre la RIGA 2 e 3 hanno la stessa PARTENZA. Cosa accomuna le tre righe? la RIGA 2 che ha la PARTENZA e ARRIVO in comune. Questo è un esempio semplice ma ci sono casi più complessi come quello che allego sotto.


PARTENZA ARRIVO
RIGA 1: X153/E2_85 → X153/E1_85 • qui nasce la catenella dal primo valore ripetuto (ARRIVO)
RIGA 2: X153/E4_85 → X153/E1_85
RIGA 3: X153/E4_85 → X153/E10_85
RIGA 4: X152/E2_85 → X153/E10_85
RIGA 5: X152/E2_85 → X152/E6_86
RIGA 6: X152/E7_86 → X152/E6_86
RIGA 7: X152/E7_86 → X152/E8_86
RIGA 8: X153/1 → X152/E8_86
RIGA 9: X153/1 → X26b/- • qui termina la catenella dall'ultimo valore ripetuto (PARTENZA)

Mi sto scervellando tra i vari CONFRONTA, INDICE, CERCA VERT etc etc. Credo però che qui prima che cercare devo trovare una sorta di criterio di filtro, creare una sorta di valore che una volta filtrato e/o ordinato, mi faccia vedere quello che mi occorre.

Suggerimenti??? Grazie!
oz85
Utente Junior
 
Post: 36
Iscritto il: 26/03/18 14:35

Sponsor
 

Re: Creazione valore Criterio Filtro

Postdi oz85 » 07/06/18 12:18

Allego un file d'esempio che rende l'idea. Anche perchè il fattore di ricerca è "leggermente" più complesso...

https://mega.nz/#!TVNXVKwC!nDP_5DCzCE5T ... QXud4kr4jQ
oz85
Utente Junior
 
Post: 36
Iscritto il: 26/03/18 14:35

Re: Creazione valore Criterio Filtro

Postdi Marius44 » 07/06/18 17:47

Ciao
Confesso che non ho capito molto tra quello che scrivi nel 3D e quello che scrivi nel foglio.
Comunque, se ho capito bene quello che è scritto sul foglio, prova con questa macro per i dati di Partenza e Arrivo (col.E e col.M)
Codice: Seleziona tutto
Sub Filtra()
'by Marius
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'cancella dati in col.S
Columns(19).ClearContents
'assume i valori in c1 e c2
val1 = Cells(1, 3).Value
val2 = Cells(2, 3).Value
'se il Foglio è filtrato, mostra tutto
On Error Resume Next
Sheets("Foglio1").ShowAllData
On Error GoTo 0
'conta le righe impegnate
ur = Cells(Rows.Count, 1).End(xlUp).Row
'esegue un ciclo per evidenziare le condizioni poste
For i = 5 To ur
  If Sheets("Foglio1").Cells(i, 5) = val1 And Sheets("Foglio1").Cells(i, 13) = val2 Or _
    Sheets("Foglio1").Cells(i, 5) = val2 And Sheets("Foglio1").Cells(i, 13) = val1 Then
    Sheets("Foglio1").Cells(i, 19) = True
  Else
    Sheets("Foglio1").Cells(i, 19) = False
  End If
Next i
'filtra il foglio
For i = 5 To ur
  Sheets("Foglio1").Range("$A$4:S" & ur).AutoFilter field:=19, Criteria1:="VERO"
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Con quest'altra macro, invece, avrei voluto fare quello che chiedi nella discussione, ma non credo faccia quello che vuoi. Contgrolla.
Codice: Seleziona tutto
Sub FiltraCatena()
'by Marius
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'cancella dati in col.S
Columns(19).ClearContents
'se il Foglio è filtrato, mostra tutto
On Error Resume Next
Sheets("Foglio1").ShowAllData
On Error GoTo 0
'conta le righe impegnate
ur = Cells(Rows.Count, 1).End(xlUp).Row
'esegue un ciclo per evidenziare le condizioni poste
For i = 5 To ur - 1
  flag = 0
  If Sheets("Foglio1").Cells(i, 4) = Sheets("Foglio1").Cells(i + 1, 4) Then flag = 1
  If Sheets("Foglio1").Cells(i, 4) = Sheets("Foglio1").Cells(i + 1, 12) Then flag = 1
  If Sheets("Foglio1").Cells(i, 12) = Sheets("Foglio1").Cells(i + 1, 4) Then flag = 1
  If Sheets("Foglio1").Cells(i, 12) = Sheets("Foglio1").Cells(i + 1, 12) Then flag = 1
 
  If flag = 1 Then
    Sheets("Foglio1").Cells(i, 19) = True
    Sheets("Foglio1").Cells(i + 1, 19) = True
  Else
    Sheets("Foglio1").Cells(i, 19) = False
    Sheets("Foglio1").Cells(i + 1, 19) = False
  End If
Next i
'filtra il foglio
For i = 5 To ur
  Sheets("Foglio1").Range("$A$4:S" & ur).AutoFilter field:=19, Criteria1:="VERO"
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Quest'altra macro mostra tutti i dati (toglie il filtro)
Codice: Seleziona tutto
Sub Mostra()
Columns(19).ClearContents
On Error Resume Next
Sheets("Foglio1").ShowAllData
On Error GoTo 0
Cells(4, 1).AutoFilter
End Sub


ATTENTO che ho usato una colonna d'appoggio (la col.S)
Ti allego il file: http://www.filedropper.com/foglioprovavba

Fai sapere. Ciao,
Mario
Marius44
Utente Senior
 
Post: 329
Iscritto il: 07/09/15 22:00

Re: Creazione valore Criterio Filtro

Postdi oz85 » 08/06/18 08:00

Innazitutto grazie per la pazienza ed il tempo Mario, sei stato gentilissimo nel creare questo file utilissimo.
Come hai detto tu, non mi sono spiegato bene. Questi filtri applicati mezzo macro è qualcosa che sono riuscito a tirar fuori ma non fanno al mio caso.

Nel foglio creato da te (che trovi caricato nel link sotto), effettuo dei filtri singoli che non mi permettono di visualizzare quello che mi occorre. Nel dettaglio vorrei visualizzare tutti i cavi che hanno come criterio:

• VALORE 1 + VALORE 2
• Partenza / Arrivo in comune

Ho caricato un nuovo file che parte dal tuo dove ho aggiunto commenti e una colonna che filtra per V1/V2.

Spero di essere stato più chiaro!

Link Foglio Esempio:
https://mega.nz/#!vd8DhaDS!mrDUqw7Sjwj0 ... jSh2thdD34
oz85
Utente Junior
 
Post: 36
Iscritto il: 26/03/18 14:35

Re: Creazione valore Criterio Filtro

Postdi Marius44 » 08/06/18 15:28

Ciao
Andiamo avanti con prove fini a raggiungere il risultato.
Non ho controllato a fondo ma credo che questa macro filtra le righe dove tu hai scritto OK. Associala ad un pulsante e verifica.
Codice: Seleziona tutto
Sub Filtro_e_Catena()
'by Marius
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'cancella dati in col.S
Columns(19).ClearContents
'assume i valori in c1 e c2
val1 = Cells(1, 3).Value
val2 = Cells(2, 3).Value
'se il Foglio è filtrato, mostra tutto
On Error Resume Next
Sheets("Foglio1").ShowAllData
On Error GoTo 0
'conta le righe impegnate
ur = Cells(Rows.Count, 1).End(xlUp).Row
'esegue primo ciclo per verificare valore1 e valore2
For i = 5 To ur
  If (Sheets("Foglio1").Cells(i, 5) = val1 And Sheets("Foglio1").Cells(i, 13) = val2) Or _
    (Sheets("Foglio1").Cells(i, 5) = val2 And Sheets("Foglio1").Cells(i, 13) = val1) Then
    'se c'è corrispondenza
    'scrive VERO
    Sheets("Foglio1").Cells(i, 19) = True
    'assume PARTENZA e ARRIVO
    pt1 = Sheets("Foglio1").Cells(i, 4)
    ar1 = Sheets("Foglio1").Cells(i, 12)
    'esegue altro ciclo da qui alla fine
    'per verificare se c'è catena
    For j = i + 1 To ur - 1
      fg = 0
      pt2 = Sheets("Foglio1").Cells(j, 4)
      ar2 = Sheets("Foglio1").Cells(j, 12)
      If (Sheets("Foglio1").Cells(j + 1, 5) = val1 And Sheets("Foglio1").Cells(j + 1, 13) = val2) Or _
        (Sheets("Foglio1").Cells(j + 1, 5) = val2 And Sheets("Foglio1").Cells(j + 1, 13) = val1) Then
        pt3 = Sheets("Foglio1").Cells(j + 1, 4)
        ar3 = Sheets("Foglio1").Cells(j + 1, 12)
      End If
      'se partenza1 = partenza2, partenza1 = arrivo2, arrivo1 = partenza2, arrivo1 = arrivo2
      'se partenza2=partenza3, partenza2=arrivo3,partenza3 = arrivo2, arrivo2=arrivo3
      If pt1 = pt2 Or pt1 = ar2 Or ar1 = pt2 Or ar1 = ar2 Or _
        pt2 = pt3 Or pt2 = ar3 Or pt3 = ar2 Or ar2 = ar3 Then
        Sheets("Foglio1").Cells(j, 19) = True
        Sheets("Foglio1").Cells(j + 1, 19) = True
      Else
        Exit For
      End If
    Next j
  End If
Next i
'filtra il foglio
For i = 5 To ur
  Sheets("Foglio1").Range("$A$4:S" & ur).AutoFilter field:=19, Criteria1:="VERO"
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Fai sapere. Ciao,
Mario

PS - Alla fine la/le macro andranno "professionalizzate" (dichiarazioni di variabili, settaggio di aree, Option Explicit, ecc) altrimenti Anthony ci picchia. :lol:
Marius44
Utente Senior
 
Post: 329
Iscritto il: 07/09/15 22:00

Re: Creazione valore Criterio Filtro

Postdi oz85 » 09/06/18 14:08

Ciao Mario! Non ci siamo ancora. La logica con la quale filtra ancora rappresenta quello che mi occorre. Prendi come esempio le righe che vanno da 80 a 84. Le ho evidenziate di altro colore. Con i valori 1 e 2 impostati con i codici 3010851 e 3010674 perchè occorre che visualizzi le righe precedentemente scritte?
Perchè il filtro deve lavorare secondo 2 criteri. Il primo è che V1+V2 o V2+V1 siano contenuti nel concatena delle colonne E e M (rispettivamente TERM.LE1 e TERM.LE2) e l'altro criterio è che la PARTENZA o l'ARRIVO laddove hanno lo stesso valore continuano ad associare il valore "x" che dovrebbe rappresentare il valore che accomuna le righe da visualizzare. Nel concreto la cella D81 della colonna PARTENZA ha il valore "X153/Xb", e il valore E81 della colonna TERM.LE1 ha il codice "3010674", dall'altro lato il valore di ARRIVO (L81) è "X153/E10_86", mentre il valore di TERM.LE2 (M81) è "3010851". Questa riga va filtrata perchè V1+V2 o V2+V1 è uguale al concatena dei valori TERM.LE1 + TERM.LE2. Poi vanno filtrate tutte le righe che in PARTENZA o ARRIVO nella riga prima o in quella sotto ha lo stesso valore. Sempre nella cella D81 il valore è X153/Xb nella cella sopra (D80) è sempre X153/Xb anche se i valori TERM.LE1 e TERM.LE2 sono diversi, la stessa PARTENZA li accomuna, quindi voglio visualizzarli. Questo va fatto su tutti e soprattutto considerando che voglia settare i VALORI 1 e 2 in maniera diversa.

So che è complesso ma spero di aver reso meglio l'idea questa volta.

In ogni caso grazie per la perseveranza!!
oz85
Utente Junior
 
Post: 36
Iscritto il: 26/03/18 14:35

Re: Creazione valore Criterio Filtro

Postdi Marius44 » 09/06/18 17:29

Ciao
Premesso che quei valori da te indicati li vedo in D183 e non in D81, ho riportato i dati (solo quelli che interessano) in Foglio3 ed ho "aggiustato" la macro come sotto riportato.
Codice: Seleziona tutto
Sub Filtro_Prova()
'by Marius
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'se il Foglio è filtrato, mostra tutto
On Error Resume Next
Sheets("Foglio3").ShowAllData
On Error GoTo 0
'cancella dati in col.w
Columns(19).ClearContents
'assume i valori in c1 e c2
val1 = Cells(1, 3).Value
val2 = Cells(2, 3).Value
'conta le righe impegnate
ur = Cells(Rows.Count, 4).End(xlUp).Row
'esegue ciclo per verificare valore1 e valore2
For i = 5 To ur
  If (Cells(i, 5) = val1 And Cells(i, 13) = val2) Or _
    (Cells(i, 5) = val2 And Cells(i, 13) = val1) Then
    'se c'è corrispondenza
    'assume valori partenza e arrivo
    pz = Cells(i, 4)
    ar = Cells(i, 12)
    'se nel rigo sotto o spra c'è corrispondenza, scrive in col.W
    If (Cells(i - 1, 4) = pz Or Cells(i + 1, 4) = pz) And _
      (Cells(i - 1, 12) = ar Or Cells(i + 1, 12) = ar) Then
      Cells(i - 1, 19) = True
      Cells(i + 1, 19) = True
      Cells(i - 1, 19) = True
      Cells(i + 1, 19) = True
      Cells(i, 19) = True
    End If
  End If
Next i
'filtra il foglio
For i = 5 To ur
  Sheets("Foglio3").Range("$A$4:S" & ur).AutoFilter field:=19, Criteria1:="VERO"
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
Sub Scopri()
Columns(19).ClearContents
On Error Resume Next
Sheets("Foglio3").ShowAllData
On Error GoTo 0
Cells(4, 1).AutoFilter
End Sub


Non ho fatto alcuna prova per vedere se la "catena" è più lunga di 3 righe.

File a questo link: http://www.filedropper.com/foglioprovavba_1

Ciao,
Mario
Marius44
Utente Senior
 
Post: 329
Iscritto il: 07/09/15 22:00

Re: Creazione valore Criterio Filtro

Postdi oz85 » 10/06/18 19:22

Ci siamo quasi... nel senso che la macro ha filtrato i cavi interessati ma non tutti i restanti. Le catene tra partenza e arrivo non hanno un limite e possono essere molte...

In ogni caso, ripeto il criterio di filtro per il quale se si riesce ad attribuire un valore, il tutto può essere comodamente filtrato. Il problema è che non rieco a trovare la logica da applicare alle righe affinchè abbiano un valore in comune in base a quello che voglio visualizzare.

1°CRITERIO
La riga deve contenere in TERM.LE1 e TERM.LE2 i valori V1+V2 o V2+V1

2°CRITERIO
Dopo aver filtrato queste righe, le altre che devono essere visualizzate si basano su PARTENZA e ARRIVO. Ma non ragionano per riga ma per valore sopra e sotto la cella della relativa colonna. Quindi, se nella cella A2 (per esempio) c'è il valore X5/1 e/o sopra/sotto ci sono i valori X5/1 allora quelle righe vanno incluse nella visualizzazione. Sto cercando con i SE, E, O di giungere ad un valore unico da filtrare e poter ordinare che associato ad una macro possa, una volta cliccato il tasto, visualizzare quello di cui si necessita una volta impostati i VALORE1 e 2.

Nel file caricato da Mario si trovano nelle righe 157, 158 e 159 l'esempio che rappresenta il mio concetto.

* DA INCLUDERE NELLA RICERCA

_________ PARTENZA ____________ ARRIVO
RIGA 157___ X153/Pa___ 3010674___ X153/E8_30___ 3010851
RIGA 158___ X153/E8_86___ 3010851___ X153/E8_30___ 3010851
RIGA 159___ X153/E8_86___ 3010851___ X153/E7_86___ 3010676

* DA NON INCLUDERE NELLA RICERCA

RIGA 160___ X153/17b___ 3010674___ X153/18a___ 3010674


Nella RIGA 159 si trova la coppia di valori 1/2 (3010851 - 3010676). Ora a partire da quella riga bisogna salire, in questo caso, di due righe in quanto nonostante i VALORI siano differenti la cosa che li accomuna sono le PARTENZE e l'ARRIVO il che li rendono parte di una "catena". Quindi la RIGA 158, subito sopra trova la stessa PARTENZA della RIGA 159, quindi va inserita nella RICERCA. Stessa cosa per la RIGA 157 che contiene lo stesso ARRIVO (X153/E8_30). Mentre la RIGA 160 non va inclusa in quanto i VALORI non sono contenuti e la PARTENZA e ARRIVO non sono identiche ai valori della RIGA 159.

So che è complesso ma questo è il blocco al quale sono arrivato...
oz85
Utente Junior
 
Post: 36
Iscritto il: 26/03/18 14:35

Re: Creazione valore Criterio Filtro

Postdi Marius44 » 11/06/18 08:45

Ciao
Mi auguro di aver trovato :) :) :)
Questa la macro
Codice: Seleziona tutto
Sub Filtro_Prova_Tre()
'by Marius
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'se il Foglio è filtrato, mostra tutto
On Error Resume Next
Sheets("Foglio3").ShowAllData
On Error GoTo 0
'cancella dati in col.S e T
Columns("S:U").ClearContents
'assume i valori in c1 e c2
val1 = Cells(1, 3).Value
val2 = Cells(2, 3).Value
'conta le righe impegnate
ur = Cells(Rows.Count, 4).End(xlUp).Row
'esegue ciclo per verificare valore1 e valore2
For i = 5 To ur
  If (Cells(i, 5) = val1 And Cells(i, 13) = val2) Or _
    (Cells(i, 5) = val2 And Cells(i, 13) = val1) Then
    Cells(i, 19) = "x"
  End If
Next i
For i = 5 To ur
  If Cells(i, 19) = "x" Then
    Cells(i, 20) = "x"
    'assume partenza e arrivo
    pz = Cells(i, 4).Value
    ar = Cells(i, 12).Value
    'inizio ciclo verifica righe precedenti
    For j = i To 5 Step -1
    ' se trova corrispondenza scrive x
      If Cells(j, 4) = pz Or Cells(j, 12) = pz Or _
        Cells(j, 4) = ar Or Cells(j, 12) = ar Then
        Cells(j, 20) = "x"
        'deve assumere i valori pz e ar di questa riga per la verifica precedente
        pz1 = Cells(j, 4): ar1 = Cells(j, 12)
        For k = j To 5 Step -1
          If Cells(k, 4) = pz1 Or Cells(k, 12) = pz1 Or _
            Cells(k, 4) = ar1 Or Cells(k, 12) = ar1 Then
            Cells(k, 20) = "x"
          Else
            Exit For
          End If
        Next k
      Else
        Exit For
      End If
    Next j
    'inizio ciclo verifica righe successive
    For j = i To ur
    'se trova corrispondenza scrive x
      If Cells(j, 4) = pz Or Cells(j, 12) = pz Or _
      Cells(j, 4) = ar Or Cells(j, 12) = ar Then
        Cells(j, 20) = "x"
        'deve assumere i valori pz e ar di questa riga per la verifica successiva
        pz1 = Cells(j, 4): ar1 = Cells(j, 12)
        For k = j To ur
          If Cells(k, 4) = pz1 Or Cells(k, 12) = pz1 Or _
            Cells(k, 4) = ar1 Or Cells(k, 12) = ar1 Then
            Cells(k, 20) = "x"
          Else
            Exit For
          End If
        Next k
      Else
        Exit For
      End If
    Next j
  End If
Next i
For i = 5 To ur - 1
  If Cells(i, 20) = "x" And Cells(i + 1, 20) = "x" Then
    Cells(i, 21) = "x": Cells(i + 1, 21) = "x"
  End If
Next i
'filtra il foglio
For i = 5 To ur
  Sheets("Foglio3").Range("$A$4:U" & ur).AutoFilter field:=21, Criteria1:="x"
Next i
Columns("S:U").ClearContents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

E' senza alcun dubbio migliorabile ma mi pare che faccia quello che chiedi. Fai un controllo e ... sentiamoci.
Allego il file: http://www.filedropper.com/foglioprovavba_2. Vai al Foglio3 e usa i pulsanti.


Ciao,
Mario


PS - Sono preoccupato per il ... silenzio di Anthony :?:
Marius44
Utente Senior
 
Post: 329
Iscritto il: 07/09/15 22:00

Re: Creazione valore Criterio Filtro

Postdi oz85 » 11/06/18 12:22

Grazie Mario! ottimo per il momento sembra andare tutto bene, nei prossimi giorni testerò il tutto con altri file e sopratutto con altri valori e aggiornerò il tutto, per il momento Grazie!
oz85
Utente Junior
 
Post: 36
Iscritto il: 26/03/18 14:35

Re: Creazione valore Criterio Filtro

Postdi Anthony47 » 11/06/18 18:45

Mario, quando io ero ancora a chiedermi "Cioe' che bisogna fare?" tu sei uscito gia' con la prima macro; ho ancora continuato a farmi la stessa domanda mentre tu uscivi con la seconda versione, la terza etc, per cui ho scelto di rimanere alla finestra e fare il tifo.
Come sempre, "se funziona e' ottima" quindi non aspettarti ne' strali ne' suggerimenti

Dico solo: complimenti!

Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15531
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Creazione valore Criterio Filtro

Postdi oz85 » 11/06/18 19:30

Grazie Anthony per tutto il supporto che dai al forum grazie alla quale ho risolto tantissimi problemi e mi hai dato diversi input su come vedere le cose (parlo a livello di macro e possibili soluzioni). Questo forum è manna per chi vuole approfondire argomenti anche se non ha i mezzi per farlo completamente in maniera autodidatta. Top!

Anthony47 ha scritto:Mario, quando io ero ancora a chiedermi "Cioe' che bisogna fare?" tu sei uscito gia' con la prima macro; ho ancora continuato a farmi la stessa domanda mentre tu uscivi con la seconda versione, la terza etc, per cui ho scelto di rimanere alla finestra e fare il tifo.
Come sempre, "se funziona e' ottima" quindi non aspettarti ne' strali ne' suggerimenti

Dico solo: complimenti!

Ciao.
oz85
Utente Junior
 
Post: 36
Iscritto il: 26/03/18 14:35

Re: Creazione valore Criterio Filtro

Postdi Marius44 » 11/06/18 20:09

Buonasera a tutti

@Anthony
Innanzi tutto grazie per i graditissimi complimenti (poi, fatti da te valgono ... doppio :) )
Circa il tuo "silenzio" intendevo che, si va be' che funziona, ma dobbiamo renderla più professionale!
Aspetto che l'Utente confermi il buon funzionamento e poi vedrò (o, meglio, vedremo :lol: tu ed io, ma più tu che io), di migliorarla.

Come te, all'inizio non capivo cosa volessero dire quelle due condizioni. Poi, poco a poco, ho fatto i ... conti della serva e, sembra, sia uscito il coniglio dal cilindro.

Aspettiamo. Ciao a tutti,
Mario
Marius44
Utente Senior
 
Post: 329
Iscritto il: 07/09/15 22:00

Re: Creazione valore Criterio Filtro

Postdi Marius44 » 12/06/18 09:11

Buongiorno a tutti

Penso che sia necessario l'intervento di Anthony :oops: (Arrossisco per quello che ritengo sia un errore).

Stavo "rivedendo" il codice e mi sono accorto di qualcosa che, a mio avviso, non è coerente.
Le righe 130 e 131 NON dovrebbero essere filtrate in quanto, pur avendo VALORE1 e VALORE2 compatibili, non hanno nè la partenza nè l'arrivo uguali.

Ho cercato di capire questa stranezza senza risultato.
Qualcuno è in grado di spiegarmi? Grazie. Ciao,
Mario
Marius44
Utente Senior
 
Post: 329
Iscritto il: 07/09/15 22:00

Re: Creazione valore Criterio Filtro

Postdi Marius44 » 12/06/18 18:51

Ciao a tutti

E' proprio vero che "chi la dura la vince" :lol:

Come detto nel post precedente, rivedendo la macro mi sono accorto di un errore (righe 130/131 ma anche le righe 193/194).
Ti posto la macro, da assegnare ad un pulsante (non a quello precedente, inseriscine un altro per notare la differenza).
Vedrai che con Prova Tre rimangono 22 righe e con Prova Four ne rimangono 18. Appunto le due coppie dette sopra non hanno motivo di essere filtrate).
Codice: Seleziona tutto
Sub Filtro_Prova_Four() 'by Marius
Dim val1 As Long, val2 As Long, ur As Long
Dim i As Long, j As Long, k As Long
Dim pz As String, ar As String, pz1 As String, ar1 As String
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set ws = ActiveSheet
'se il Foglio è filtrato, mostra tutto
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
'cancella dati in col.S:U
Columns("S:U").ClearContents
'assume i valori in c1 e c2
val1 = Cells(1, 3).Value
val2 = Cells(2, 3).Value
'conta le righe impegnate
ur = Cells(Rows.Count, 4).End(xlUp).Row
'esegue ciclo per verificare valore1 e valore2
For i = 5 To ur
  If (Cells(i, 5) = val1 And Cells(i, 13) = val2) Or _
    (Cells(i, 5) = val2 And Cells(i, 13) = val1) Then
    Cells(i, 19) = "x"
  End If
Next i
For i = 5 To ur
  If Cells(i, 19) = "x" Then
    'assume partenza e arrivo
    pz = Cells(i, 4).Value
    ar = Cells(i, 12).Value
    'inizio verifica righe sovrastanti
    For j = i - 1 To 5 Step -1
      'confronta partenza e arrivo con cella immediatamente sopra
      If Cells(j, 4) = pz Or Cells(j, 12) = pz Or _
        Cells(j, 4) = ar Or Cells(j, 12) = ar Then
        'trovata corrispondenza, scrive "x" in col.20
        Cells(i, 20) = "x"
        Cells(j, 20) = "x"
        'assume valori pz e ar di questa riga per verifica
        pz1 = Cells(j, 4): ar1 = Cells(j, 12)
        For k = j - 1 To 5 Step -1
          If Cells(k, 4) = pz1 Or Cells(k, 12) = pz1 Or _
            Cells(k, 4) = ar1 Or Cells(k, 12) = ar1 Then
            Cells(k, 20) = "x"
          Else
            Exit For
          End If
        Next k
      Else
        Exit For
      End If
    Next j
    'inizio ciclo verifica righe sottostanti
    For j = i + 1 To ur
    'se trova corrispondenza scrive x
      If Cells(j, 4) = pz Or Cells(j, 12) = pz Or _
      Cells(j, 4) = ar Or Cells(j, 12) = ar Then
        'trovata corrispondenza, scrive "x" in col.20
        Cells(i, 20) = "x"
        Cells(j, 20) = "x"
        'assume valori pz e ar di questa riga per verifica
        pz1 = Cells(j, 4): ar1 = Cells(j, 12)
        For k = j + 1 To ur
          If Cells(k, 4) = pz1 Or Cells(k, 12) = pz1 Or _
            Cells(k, 4) = ar1 Or Cells(k, 12) = ar1 Then
            Cells(k, 20) = "x"
          Else
            Exit For
          End If
        Next k
      Else
        Exit For
      End If
    Next j
  End If
Next i
For i = 5 To ur - 1
  If Cells(i, 20) = "x" And Cells(i + 1, 20) = "x" Then
    Cells(i, 21) = "x": Cells(i + 1, 21) = "x"
  End If
Next i
'filtra il foglio
For i = 5 To ur
  ws.Range("$A$4:U" & ur).AutoFilter field:=21, Criteria1:="x"
Next i
Columns("S:U").ClearContents
Set ws = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Riprova e fai sapere. Ciao,
Mario
Marius44
Utente Senior
 
Post: 329
Iscritto il: 07/09/15 22:00

Re: Creazione valore Criterio Filtro

Postdi Anthony47 » 12/06/18 21:56

Ah, meno male...
Perche' io sarei partito dalla domanda che non ho mai fatto: "Cioe' che bisogna fare?" :D

CIAO!
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15531
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Creazione valore Criterio Filtro

Postdi oz85 » 14/06/18 15:11

Eccomi qui! scusate che sono stato gli ultimi giorni a fare un corso e non sono riuscito a darci un occhiata.
Provo il tutto il prima possibile! Grazie tante Mario!

Marius44 ha scritto:Ciao a tutti

E' proprio vero che "chi la dura la vince" :lol:

Come detto nel post precedente, rivedendo la macro mi sono accorto di un errore (righe 130/131 ma anche le righe 193/194).
Ti posto la macro, da assegnare ad un pulsante (non a quello precedente, inseriscine un altro per notare la differenza).
Vedrai che con Prova Tre rimangono 22 righe e con Prova Four ne rimangono 18. Appunto le due coppie dette sopra non hanno motivo di essere filtrate).
Codice: Seleziona tutto
Sub Filtro_Prova_Four() 'by Marius
Dim val1 As Long, val2 As Long, ur As Long
Dim i As Long, j As Long, k As Long
Dim pz As String, ar As String, pz1 As String, ar1 As String
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set ws = ActiveSheet
'se il Foglio è filtrato, mostra tutto
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
'cancella dati in col.S:U
Columns("S:U").ClearContents
'assume i valori in c1 e c2
val1 = Cells(1, 3).Value
val2 = Cells(2, 3).Value
'conta le righe impegnate
ur = Cells(Rows.Count, 4).End(xlUp).Row
'esegue ciclo per verificare valore1 e valore2
For i = 5 To ur
  If (Cells(i, 5) = val1 And Cells(i, 13) = val2) Or _
    (Cells(i, 5) = val2 And Cells(i, 13) = val1) Then
    Cells(i, 19) = "x"
  End If
Next i
For i = 5 To ur
  If Cells(i, 19) = "x" Then
    'assume partenza e arrivo
    pz = Cells(i, 4).Value
    ar = Cells(i, 12).Value
    'inizio verifica righe sovrastanti
    For j = i - 1 To 5 Step -1
      'confronta partenza e arrivo con cella immediatamente sopra
      If Cells(j, 4) = pz Or Cells(j, 12) = pz Or _
        Cells(j, 4) = ar Or Cells(j, 12) = ar Then
        'trovata corrispondenza, scrive "x" in col.20
        Cells(i, 20) = "x"
        Cells(j, 20) = "x"
        'assume valori pz e ar di questa riga per verifica
        pz1 = Cells(j, 4): ar1 = Cells(j, 12)
        For k = j - 1 To 5 Step -1
          If Cells(k, 4) = pz1 Or Cells(k, 12) = pz1 Or _
            Cells(k, 4) = ar1 Or Cells(k, 12) = ar1 Then
            Cells(k, 20) = "x"
          Else
            Exit For
          End If
        Next k
      Else
        Exit For
      End If
    Next j
    'inizio ciclo verifica righe sottostanti
    For j = i + 1 To ur
    'se trova corrispondenza scrive x
      If Cells(j, 4) = pz Or Cells(j, 12) = pz Or _
      Cells(j, 4) = ar Or Cells(j, 12) = ar Then
        'trovata corrispondenza, scrive "x" in col.20
        Cells(i, 20) = "x"
        Cells(j, 20) = "x"
        'assume valori pz e ar di questa riga per verifica
        pz1 = Cells(j, 4): ar1 = Cells(j, 12)
        For k = j + 1 To ur
          If Cells(k, 4) = pz1 Or Cells(k, 12) = pz1 Or _
            Cells(k, 4) = ar1 Or Cells(k, 12) = ar1 Then
            Cells(k, 20) = "x"
          Else
            Exit For
          End If
        Next k
      Else
        Exit For
      End If
    Next j
  End If
Next i
For i = 5 To ur - 1
  If Cells(i, 20) = "x" And Cells(i + 1, 20) = "x" Then
    Cells(i, 21) = "x": Cells(i + 1, 21) = "x"
  End If
Next i
'filtra il foglio
For i = 5 To ur
  ws.Range("$A$4:U" & ur).AutoFilter field:=21, Criteria1:="x"
Next i
Columns("S:U").ClearContents
Set ws = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Riprova e fai sapere. Ciao,
Mario
oz85
Utente Junior
 
Post: 36
Iscritto il: 26/03/18 14:35


Torna a Applicazioni Office Windows


Topic correlati a "Creazione valore Criterio Filtro":


Chi c’è in linea

Visitano il forum: Nessuno e 20 ospiti