|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao, devo risolvere un problema, che in realtà è una variante di quello già visto QUILe differenze sostanziali sono: -il Box in Tabella1 anziché essere di 1+10 righe è di 1+15 -le celle dei codici da evidenziare sono solo all’interno di questo Box15 -la condizione perché vengano evidenziati è che i codici siano presenti nel Box15 almeno per 2 volte -i codici esterni al Box (quelli a -5/+5 rispetto al Box10 della macro di riferimento) in questa ricerca non ci interessano, quindi le relative istruzioni vanno ignorate. Come al solito- dato che si tratta di istruzioni molto elaborate e sopra tutto precise, anche da un punto di vista di linguaggio VBA ...quindi per me, a questi livelli, è buio pesto- chiedo l’ennesimo (nel vero senso della parola) aiuto. Grazie infinite, buona giornata eZio
|
|
|
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve servirebbe una rinfrescata per ricostruire la logica. la macro che segue, elabora la tabella in questo modo. prende come riferimento la cella selezionata della tabella1 crea un'area di lavoro di 15 righe, per ogni valore nell'area controlla quanti sono i valori ripetuti, se maggiori o uguali a 2 assegna un colore di sfondo. Sub tabella15() riga = ActiveCell.Row Set Area = Range(Cells(riga, 3), Cells(riga + 15, 7)) Area.Interior.ColorIndex = xlNone For Each cla In Area If cla.Interior.ColorIndex = xlNone Then x = Application.WorksheetFunction.CountIf(Area, cla.Value) If x >= 2 Then For Each cl2 In Area If cl2 = cla Then cl2.Interior.ColorIndex = 3 End If Next End If End If Next End Sub saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao, scusa se non mi sono dilungato nell'approfondire la richiesta, perché avrei ripetuto gran parte di quanto già esposto nel 3d del LINK... Ecco in sostanza la variante di cui ho bisogno. SITUAZIONE DI PARTENZA (esempio): Tabella1 in giallo, Tabella2 in verde Tabelle filtrate sul codice 8 di col.P Situazione specifica di col.O (tabella2) osservando la col.B: il cod.70 presente in magazzino nel Sett.73’21 il cod.18 presente nel Sett.73’06 il cod.74 presente nel Sett.72’94 la macro del 3d linkato, quella a fine 3d, in base alla selezione dell'intervallo filtrato di col.O intercetta nella tabella1 non filtrata i sett. corrispondenti (in col.B) e crea per ciascuno di essi un Box10 di range "C:G" comprendente la riga del sett. intercettato più 10 righe superiori, poi intercetta in tabella1 i codici di tabella2-selezione e: -se sono esterni, ma entro le 4 righe in basso rispetto al Box10 a cui si riferiscono, in tabella2-selezione ne colora di verde la cella -se sono esterni, ma entro le 4 righe in alto rispetto al Box10 a cui si riferiscono, in tabella2-selezionene ne colora di azzurro la cella -se sono interni al Box10 li ignora Nella macro c'è poi un gruppo di istruzioni For Each mval3 In area10 If mval3 = nextItx Then With Cells(i + 1, col).Borders .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = 3 End With Exit For End If Next mval3 Exit For che in questa ricerca non ci interessano. le differenze rispetto alla richiesta del 3d del link, e relativa macro, sono: -il Box in Tabella1 anziché essere di 1+10 righe è di 1+15 -le celle dei codici da evidenziare nella selezione di tabella2 sono solo quelle all’interno di questo "Box15" -la condizione perché vengano evidenziati è che i codici siano presenti nel Box15 almeno per 2 volte -i codici esterni al Box (quelli a -5/+5 rispetto al Box10 della macro di riferimento) in questa ricerca non ci interessano. Spero di avere illustrato in modo chiaro il problema, Grazie assai e buona serata, eZioNota: la macro che mi hai preparato mi è stata utilissima per risovere un altro degli innumerevoli problemi disseminati nel "teatro delle mie operazioni"................. :)))) Grazie!!
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve ho provato a ricostruire la logica del lavoro fatto precedentemente. vedi se queste modifiche fatte alla macro portano al risultato voluto. Sub coloraselezione15() Dim rng As Range, rng1 As Range, rng2 As Range, area15 As Range Dim mysett As Variant, sett As Variant, Itx As Variant Dim Mval As Variant, Mval2 As Variant, mval3 As Variant Dim Area As Range, Ctrl As Boolean Set rng = Range("B3", Range("B3").End(xlDown)) Set rng1 = Range(Cells(3, 3), Cells(rng.Rows.Count + 2, 7)) With rng1 .Interior.ColorIndex = xlNone End With Set rng1 = Nothing col = Selection.Column counter = 0 '-------------------------------------- ' Definisce l'area di selezione e conta le righe della selezione miorange = Selection.Address Set Area = Range(miorange).SpecialCells(xlCellTypeVisible) For Each sel In Area righe = righe + sel.Rows.Count Next '------------------------------------------- For Each Itx In Area counter = counter + 1 mysett = Cells(Itx.Row, 2).Value i = Itx.Row Do While Cells(i + 1, col).EntireRow.Hidden = True i = i + 1 Loop ' il contatore serve per definire il limite di NextItx nel caso di selezioni parziali 'dei codici visibili------------------------------------------------------- If counter <= righe Then NextItx = Cells(i + 1, col).Value Else NextItx = "" End If '------------------------------------------------------------- For Each sett In rng If sett = mysett Then riga = sett.Row '---------------------controllo Riga della selezione blk1 = riga - 15 If blk1 <= 3 Then blk1 = 3 ' '------------------------------------------------------------------------- Set area15 = Range(Cells(blk1, 3), Cells(riga, 7)) '***************** For Each mval3 In area15 If mval3.Interior.ColorIndex = xlNone Then Ccont = Application.WorksheetFunction.CountIf(area15, mval3.Value) If Ccont >= 2 Then For Each cl2 In area15 If cl2 = mval3 Then cl2.Interior.ColorIndex = 3 End If Next End If End If Next mval3 End If Next sett Ctrl = False Next Itx Set area15 = Nothing Set Area = Nothing Set rng = Nothing End Sub saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao, ho provato la macro, ma purtroppo non risolve il mio problema... ho preparato un SAMPLE per chiarire cosa dovrebbe fare e cosa fa la macro, sperando di chiarire ciò che con essa devo fare. Per chiarezza esplicativa in tabella1 ho colorato solo i Box15 dei codici filtrati di tabella2-selezione che nel Box15 si ripetono almeno due volte. Grazie assai per la somma pazienza, buona notte eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve il file di esempio chiarisce la logica che intendi applicare. Quello che non arrivo a capire è questo: applichi un filtro per colore nella colonna H - Quale colore Filtri? il rosso?? se si perchè il prio box15 parte da riga 22 e non da riga 13?? la macro è già fatta ma ho bisogno di sapere con esattezza la logica del filtro che applichi. saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao, scusami, ma ho potuto accedere alla rete solo ora... Commenta:applichi un filtro per colore nella colonna H - Quale colore Filtri? il rosso?? affermativo: filtro per colore rosso Commenta:se si perchè il prio box15 parte da riga 22 e non da riga 13?? come ho scritto sopra, ho colorato solo i Box15 dei codici filtrati di tabella2-selezione che nel Box15 si ripetono almeno due volte perché altrimenti sarebbe uscita un'arlecchinata poco comprensibile, ma hai perfettamente ragione... il primo Box15 è a riga 13, poi a riga 22, 49, 97, 189, 249, 262, 273. Grazie assai e buon pomeriggio eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve con la premessa che la macro è tutta da provare, eccola! Sub coloraselezione15() Dim rng As Range,rng2 As Range, area15 As Range Dim mysett As Variant, sett As Variant, Itx As Variant Dim Mval As Variant, Mval2 As Variant, mval3 As Variant Dim Area As Range, Ctrl As Boolean Set rng = Range("B3", Range("B3").End(xlDown)) col = Selection.Column counter = 0 '-------------------------------------- ' Definisce l'area di selezione e conta le righe della selezione miorange = Selection.Address Set Area = Range(miorange).SpecialCells(xlCellTypeVisible) For Each sel In Area righe = righe + sel.Rows.Count Next '------------------------------------------- For Each Itx In Area counter = counter + 1 mysett = Cells(Itx.Row, 2).Value i = Itx.Row Do While Cells(i + 1, col).EntireRow.Hidden = True i = i + 1 Loop ' il contatore serve per definire il limite di NextItx nel caso di selezioni parziali 'dei codici visibili------------------------------------------------------- If counter <= righe Then NextItx = Cells(i + 1, col).Value Else NextItx = "" End If '------------------------------------------------------------- For Each sett In rng If sett = mysett Then riga = sett.Row '---------------------controllo Riga della selezione blk1 = riga - 15 If blk1 <= 3 Then blk1 = 3 ' '------------------------------------------------------------------------- Set area15 = Range(Cells(blk1, 3), Cells(riga, 7)) Set tab2_15 = Range(Cells(blk1, col), Cells(riga, col)) tab2_15.Select '***************** For Each mval3 In area15 Ccont = Application.WorksheetFunction.CountIf(area15, mval3.Value) If Ccont >= 2 Then For Each cl2 In tab2_15 If cl2 = mval3 Then cl2.Interior.ColorIndex = 5 End If Next End If Next mval3 End If Next sett Ctrl = False Next Itx Set area15 = Nothing Set Area = Nothing Set rng = Nothing End Sub saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao, direi proprio che siamo sulla strada giusta!! ;))) ho riscontrato alcune anomalie nel lavoro della macro, che ho evidenziato nel FOGLIO2 del SAMPLEIl FOGLIO2 (2) in realtà è il FOGLIO2 senza filtro, diversamente da quanto scritto nel foglio stesso... Grazie infinite e buona serata, come sempre sei il migliore in assoluto, sia tecnicamente, sia in stile.... eZiops. hai visto il mio TATONE com'è caro e bello?? (click sul mio nome) ;)) quanto m'insegna, pur non parlando....
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve ho scaricato il file ma lo posso guardare solo domattina se non è proprio impellente. Ps. bel cagnolone, si vede che in famiglia la fa da padrone.. questo invece è l'ultimo arrivato in famiglia. Scelta obbligata per evitargli il parcheggio in canile saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve dopo una occhiata al volo al tuo file, non mi pare di riscontrare errori. il record da te indicato rigo 249 è normale che sia colorato di blu perchè appartiene al box 15 di pertinenza del valore 146 di riga 262 se così non dovesse essere va rivista completamente tutta la macro. saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao, Commenta:ho scaricato il file ma lo posso guardare solo domattina se non è proprio impellente. non c'è alcun problema...!! ;)) Purtoppo il "capocommessa" è il codice che inizialmente è nella cella di colore ROSSO, in tabella2 filtrata-selezione, anche se poi in tabella1 sarà contenuto in un altro Box15. Il fatto che non si ripete all'interno del proprio Box15 (da esso generato, indipendentemente dalla sua posizione relativa nel Box15 di un altro codice) lo esclude dai requisiti di modifica del colore-cella da ROSSO a BLU. Grazie infinite per la immensa pazienza, buona serata eZio Inizio OT_ps. il tuo cucciolone è davvero bellissimo!! ...e saprà di sicuro meritarsi tutto il vostro affetto ;)) Socrate, uno dei Filosofi a me più cari in assoluto, disse: "più conosco la gente, più amo il mio Cane"... E hai azzeccato in pieno, il mio Bilbo la fà da padrone _ Fine OT.
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve forse ho capito il concetto di "capocommessa"..!! la macro postata, controllava i doppioni nel box 15 e li comparava non al solo capocommessa ma a tutte le righe del box 15. vedi se ora la soluzione è corretta: Sub coloraselezione15() Dim rng As Range, rng2 As Range, area15 As Range Dim mysett As Variant, sett As Variant, Itx As Variant Dim Mval As Variant, Mval2 As Variant, mval3 As Variant Dim Area As Range, Ctrl As Boolean Set rng = Range("B3", Range("B3").End(xlDown)) col = Selection.Column counter = 0 '-------------------------------------- ' Definisce l'area di selezione e conta le righe della selezione miorange = Selection.Address Set Area = Range(miorange).SpecialCells(xlCellTypeVisible) For Each sel In Area righe = righe + sel.Rows.Count Next '------------------------------------------- For Each Itx In Area counter = counter + 1 mysett = Cells(Itx.Row, 2).Value i = Itx.Row Do While Cells(i + 1, col).EntireRow.Hidden = True i = i + 1 Loop ' il contatore serve per definire il limite di NextItx nel caso di selezioni parziali 'dei codici visibili------------------------------------------------------- If counter <= righe Then NextItx = Cells(i + 1, col).Value Else NextItx = "" End If '------------------------------------------------------------- For Each sett In rng If sett = mysett Then riga = sett.Row '---------------------controllo Riga della selezione blk1 = riga - 15 If blk1 <= 3 Then blk1 = 3 ' '------------------------------------------------------------------------- Set area15 = Range(Cells(blk1, 3), Cells(riga, 7)) '***************** For Each mval3 In area15 Ccont = Application.WorksheetFunction.CountIf(area15, mval3.Value) If Ccont >= 2 Then If mval3 = Itx Then Itx.Interior.ColorIndex = 5 End If End If Next mval3 End If Next sett Ctrl = False Next Itx Set area15 = Nothing Set Area = Nothing Set rng = Nothing End Sub saluti giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao, controllo effettuato, perfetta!! Gran bella macro anche questa, di un'incomparabile eleganza (come tutte le tue "creature" del resto...). Ti ringrazio infinitamente, buona giornata eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve non si tratta altro che una riacconciatura della vecchia macro. Solo che stavolta c'erano di mezzo il "capocommessa" che non era stato interpretato nella giusta maniera. saluti Giap
|
|
Guest |