View Single Post
  #31   Report Post  
Posted to microsoft.public.excel.programming
keepITcool keepITcool is offline
external usenet poster
 
Posts: 2,253
Default algorithm to INVERT a multiarea selection ?


Norman
of course your code works IF the preamble is that we're trying to
'invert' a range where the 'selection criteria' is clear

The problem is INSIDE the 'invert' function we're just presented with a
multiarea range....

The function doesn't know HOW that multiarea was built. and IF it has
any identifying traits to test on.

THUS your checker method must reside in the caller procedure.

or am i missing something :)




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Norman Jones wrote :

Hi KeepItCool,

Piicking up the verbal skirmish from the third party thread,

You alluded to probleme distinguishing between a a MA 8182+ rogue
aingle area and a legitimate single area. I responded with lazy
pseudo code:

I suggested (in lazy pseudo code)

If AreasCount = 1 and If CountBlanks(Area) Then = Bug Area

You responded:

ouch.. that wont do.. think about following:
what if my rngA was specialcells(numbers)
or just a manual selection.. nah.. wont do.. :(

Ok, enlighten me as to where the following falls down - I just
code-jotted the principle, which is that a legitimate single area
will have no blank cells, whilst an 8192 bug area will have many:

Sub Detect8192Areas()
Dim Rng As Range
Dim WS As Worksheet
Set WS = Sheets.Add

WS.Range("A1") = 100 ' CVErr(xlErrNA)


Set Rng = WS.Range("A1").Resize(2)
Range("A1:A2").AutoFill Destination:=Range("A1:a16500"), _
Type:=xlFillDefault

With WS.Columns(1)
With .SpecialCells(xlConstants, xlNumbers)
Debug.Print .Areas.Count & vbTab & _
Application.CountBlank(Range(.Address))
If .Areas.Count = 1 And _
Application.CountBlank(Range(.Address)) Then
MsgBox " This range has more " & _
"than 8192 non-contiguous areas!"
End If
End With
End With

End Sub

---
Regards,
Norman

"keepITcool" wrote in message
...

Norman..

How's this for methodology?
Presuming a selection cannot have more areas than 50% of cells...
This will return a collection of ranges..
Probably should be classed .. but goes to show the idea.

Done some basic testing but even at a:z60000 with 40% random non
blanks.. returned 48 multiarea ranges(avg 7500 areas/range)in the
collection. 90secs.. (1200k cells..372k areas.. but NO errors !

so far so good :)



Function SegmentedCells(rngA As Range, scType As XlCellType, _
Optional scValue As XlSpecialCellsValue) As Collection

Const m = 8192
Dim r&, l&, s&, rngT As Range, colRaw As Collection

Set colRaw = New Collection
Set SegmentedCells = New Collection

With rngA
If .Areas.Count 1 Then
Err.Raise vbObjectError + 1, , "No MultiArea as input."
Exit Function
End If
s = (m * 2 \ .Columns.Count)
l = s
If scValue = 0 Then
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType)
Next
Else
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType, _
scValue)
Next
End If
End With


Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192 Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

End Function


--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam



Norman Jones wrote :

I agree, however, that for present purposes at least, this is
academic as: (1) there is a limit (be it at 8192 or,
sometimes, slightly less) (2) processing time increases
disproportionately above (say) 4500 areas

It clearly is both necessary and expedient to segment the ranges.
The methodology for this is something that I am lookong at now.

---
Regards,
Norman