Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao, sto cercando di inserire in una macro complessa un codice che in caso particolare chiuda comunque la macro senza bloccarsi. La macro è questa
Sub coloraselezione() Dim rng As Range, rng1 As Range, rng2 As Range, area10 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 RRiga = Selection.Row Ur = Cells(Cells.Rows.Count, col).End(xlUp).Row counter = 0 '-------------------------------------- ' Definisce l'area di selezione e conta le righe della selezione Set Area = Range(Cells(RRiga, col), Cells(Ur, col)).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 - 10 blk2 = riga - 15 blk3 = 5 If blk1 <= 3 Then blk1 = 3 If blk2 < 3 And blk1 > 3 Then blk2 = 3 ElseIf blk1 <= 3 Then Ctrl = True End If '------------------------------------------------------------------------- Set area10 = Range(Cells(blk1, 3), Cells(riga, 7)) If Not Ctrl Then Set rng1 = Cells(blk2, 3).Resize(5, 5) For Each Mval In rng1 If Mval.Value = Itx Then Itx.Interior.ColorIndex = 37 Exit For End If Next Mval End If Set rng2 = Cells(riga, 3).Offset(1, 0).Resize(blk3, 5) For Each Mval2 In rng2 If Mval2 = Itx And Itx.Interior.ColorIndex = xlNone Then Itx.Interior.ColorIndex = 43 End If Next Mval2 If nextItx = "" Then GoTo fine 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 End If Next sett Ctrl = False Next Itx fine: Set area10 = Nothing Set Area = Nothing Set rng = Nothing Set rng1 = Nothing Set rng2 = Nothing End Sub
La macro funziona a meraviglia fino quando le righe processate arrivano fino a 2 Quando la tabella è composta da una sola riga (condizione particolare) la macro si blocca Dovrei quindi inserire un codice che le permetta di bypassare questa condizione e terminare comunque il lavoro senza bloccarsi. Grazie infinite per la soluzione ;-)) eZio
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve in quale istruzione della macro viene evocato l'errore? saluti Giap
|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao carissimo, in questo blocco
Set Area = Range(Cells(RRiga, col), Cells(Ur, col)).SpecialCells(xlCellTypeVisible) For Each sel In Area righe = righe + sel.Rows.Count Next
ed evidenzia Next
(probabilmente, ma è solo una mia supposizione, perché in realtà non trova una tabella di più righe, ma la condizione particolare della presenza di una sola riga, per cui non riesce a proseguire nell'impossibile raffornto con dati di altre righe inesistenti). Grazie assai eZio
|
Rank: AiutAmico
Iscritto dal : 5/29/2003 Posts: 1,694
|
salve ho fatto una simulazione al volo. nell'istruzione che mi indichi, succede questo: se il valore di RRiga è uguale al valore di UR si priduce un loop infinito. prova ad inserire la seguente istruzione If RRiga = Ur Then Exit Sub dopo questa: Set Area = Range(Cells(RRiga, col), Cells(Ur, col)).SpecialCells(xlCellTypeVisible) prova e fa sapere saluti Giap
|
Rank: AiutAmico
Iscritto dal : 5/10/2010 Posts: 723
|
Ciao,
come sempre la tua soluzione è PERFETTA...
Mi hai anticipato: stavo infatti per precisare che non veniva evocato un vero e proprio errore, bensì il lavoro non terminava mai (loop infinito) e l'unico modo per uscirne era quello di dare il comando ESC con la tastiera e compariva la finestra con l'Avviso di codice interrotto, come hai specificato sopra.
Grazie infinite eZio
(Nota: non hai idea di quanto mi manchi... le tue "creature" sono uniche)
|