Re: VBA:Deselezionare gruppo di celle da un insieme che le comprende

[Norman Jones]

"Barbiturico" <Barbi...@discussions.microsoft.com> wrote in message
news:462FCFB8-4F87-42A6...@microsoft.com...
> E' possibile avendo nella routine selezionato per esempio
> Range("a1000:ab1000")scrivere un'istruzione che deselezioni le celle di
> Range("c1000:m1000") che vi appartengono ?Nel mio caso le celle sono
> sparse e
> ragruppate in due gruppi denominati, dei quali uno costituisce una
> selezione
> dell'altro.
> Dal forum ho imparato che si possono aggiungere celle ad un gruppo, ma non
> so come toglierle.
> Grazie in anticipo.
> --
> Sergio da Brescia

Ciao Sergio,

Prova:

'==============================>>
Public Function RngNot(RngA As Range, Optional RngB As Range) As Range
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' Code by: NDJ 24/4/2004 http://tinyurl.com/agpz9
' Using Dave Peterson's interpretation of Tom Ogilvy's
' scratch sheet idea
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
' Adapted as a function
' Amended to satisfy the need (pointed out by KeepITcool)
' to restore original validation - Validation values passed
' to and from an array
' Amended to add Non-Intersection error handling (KeepITcool)
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim Rng As Range, cell As Range, i As Long

If RngB Is Nothing Then Set RngB = RngA.Parent.UsedRange

On Error Resume Next
Set Rng = Union(RngA, RngB).SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0

If Not Rng Is Nothing Then
ReDim arr(1 To Rng.Cells.Count, 1 To 14)
i = 0
For Each cell In Rng
i = i + 1
With cell.Validation
arr(i, 1) = cell.Address
arr(i, 2) = .Type
arr(i, 3) = .AlertStyle
arr(i, 4) = .Operator
arr(i, 5) = .Formula1
arr(i, 6) = .Formula2
arr(i, 7) = .ErrorMessage
arr(i, 8) = .ErrorTitle
arr(i, 9) = .IgnoreBlank
arr(i, 10) = .InputMessage
arr(i, 11) = .InputTitle
arr(i, 12) = .ShowError
arr(i, 13) = .ShowInput
arr(i, 14) = .InCellDropdown
End With
Next cell

Rng.Validation.Delete
End If

Union(RngA, RngB).Validation.Add 0, 1

On Error Resume Next
Intersect(RngA, RngB).Validation.Delete

Set RngNot = Union(RngA, RngB). _
SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0

RngNot.Validation.Delete

If Not Rng Is Nothing Then
For i = LBound(arr) To UBound(arr)
With Range(arr(i, 1)).Validation
.Add Type:=arr(i, 2), AlertStyle:=arr(i, 3), _
Operator:=arr(i, 4), Formula1:=arr(i, 5), _
Formula2:=arr(i, 6)
.ErrorMessage = arr(i, 7)
.ErrorTitle = arr(i, 8)
.IgnoreBlank = arr(i, 9)
.InputMessage = arr(i, 10)
.InputTitle = arr(i, 11)
.ShowError = arr(i, 12)
.ShowInput = arr(i, 13)
.InCellDropdown = arr(i, 14)
End With
Next i
End If

End Function
'<<==============================

Ad esempio:
'======================>>
Public Sub TestIt()
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng As Range

Set Rng1 = Range("a1000:ab1000")
Set Rng2 = Range("c1000:m1000")
Set Rng = RngNot(Rng1, Rng2)

Rng.Interior.ColorIndex = 6

End Sub
'<<======================

Vede anche:

http://tinyurl.com/agpz9

---
Regards,
Norman

[Barbiturico]

Grazie Norman scusa il ritardo, la tua risposta merita un'approfondito studio.
--
Sergio da Brescia

"Norman Jones" ha scritto: