Aiutamici Forum
Benvenuto Ospite Cerca | Topic Attivi | Utenti | | Log In | Registra

[Excel 2007]-Codice per uscire dalla macro se... Opzioni
aetio
Inviato: Monday, August 19, 2013 9:10:04 PM

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
Sponsor
Inviato: Monday, August 19, 2013 9:10:04 PM

 
a10n11
Inviato: Tuesday, August 20, 2013 9:14:07 AM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
in quale istruzione della macro viene evocato l'errore?
saluti
Giap

aetio
Inviato: Tuesday, August 20, 2013 11:09:11 AM

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
a10n11
Inviato: Tuesday, August 20, 2013 2:56:21 PM

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

aetio
Inviato: Tuesday, August 20, 2013 3:16:34 PM

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)
Utenti presenti in questo topic
Guest


Salta al Forum
Aggiunta nuovi Topic disabilitata in questo forum.
Risposte disabilitate in questo forum.
Eliminazione tuoi Post disabilitata in questo forum.
Modifica dei tuoi post disabilitata in questo forum.
Creazione Sondaggi disabilitata in questo forum.
Voto ai sondaggi disabilitato in questo forum.

Main Forum RSS : RSS

Aiutamici Theme
Powered by Yet Another Forum.net versione 1.9.1.8 (NET v2.0) - 3/29/2008
Copyright © 2003-2008 Yet Another Forum.net. All rights reserved.