View Single Post
  #20   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..

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