Effectively assign properties from Excel range cells to an array in VBA / VB.NET

In VBA / VB.NET, you can assign Excel range values ​​to an array for faster access / manipulation. Is there a way to effectively assign other cell properties to the array (e.g. top, left, width and height)? Ie, I would like to do something like:

Dim cellTops As Variant : cellTops = Application.ActiveSheet.UsedRange.Top 

The code is part of a procedure for programmatically checking whether an image overlaps the cells that are used in a workbook. My current cell iteration method in UsedRange is slow, as it requires multiple polling for top / left / cell width / height.

Update: I'm going to accept Doug's answer, as it really works faster than a naive iteration. In the end, I found that non-naive iteration works faster for my purpose of finding controls that overlap content-filled cells. The steps are basically:

(1) Find an interesting set of rows in the range used by looking at the vertices and heights of the first cell in each row (I understand that all cells in a row should have the same top and height, but not left and not width)

(2) Iterating over cells in interesting rows and performing overlap detection using only the left and right cell positions.

The code for finding an interesting set of strings looks something like this:

 Dim feasible As Range = Nothing For r% = 1 To used.Rows.Count Dim rowTop% = used.Rows(r).Top Dim rowBottom% = rowTop + used.Rows(r).Height If rowTop <= objBottom AndAlso rowBottom >= objTop Then If feasible Is Nothing Then feasible = used.Rows(r) Else feasible = Application.Union(used.Rows(r), feasible) End If ElseIf rowTop > objBottom Then Exit For End If Next r 
+4
source share
2 answers

Todd

The best solution I thought of was to flush vertices into a range, and then flush these range values ​​into a variant array. As you said, For Next (for 10,000 cells in my test) took a few seconds. So I created a function that returns the top of the cell into which it entered. The code below is basically a function that copies the used range of the sheet that you pass to it, and then enters the function described above into each cell of the used range of the copied sheet. Then it transfers and unloads them into an array of options.

It only takes a second or about 10,000 cells. I don't know if this is useful, but it was an interesting question. If this is useful, you can create a separate function for each property or pass the desired property or return four arrays (?) ...

 Option Explicit Option Private Module Sub test() Dim tester As Variant tester = GetCellProperties(ThisWorkbook.Worksheets(1)) MsgBox tester(LBound(tester), LBound(tester, 2)) MsgBox tester(UBound(tester), UBound(tester, 2)) End Sub Function GetCellProperties(wsSourceWorksheet As Excel.Worksheet) As Variant Dim wsTemp As Excel.Worksheet Dim rngCopyOfUsedRange As Excel.Range Dim i As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual wsSourceWorksheet.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) Set wsTemp = ActiveSheet Set rngCopyOfUsedRange = wsTemp.UsedRange rngCopyOfUsedRange.Formula = "=CellTop()" wsTemp.Calculate GetCellProperties = Application.WorksheetFunction.Transpose(rngCopyOfUsedRange) Application.DisplayAlerts = False wsTemp.Delete Application.DisplayAlerts = True Set wsTemp = Nothing Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Function Function CellTop() CellTop = Application.Caller.Top End Function 

Todd

In response to your request for non-standard UDF, I can only offer a solution close to where you started. This takes 10 times more for 10,000 cells. The difference is that your back to the loop through the cells.

I am pushing my personal envelope here, so maybe someone will have access to it without a special UDF.

 Function GetCellProperties2(wsSourceWorksheet As Excel.Worksheet) As Variant Dim wsTemp As Excel.Worksheet Dim rngCopyOfUsedRange As Excel.Range Dim i As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual wsSourceWorksheet.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) Set wsTemp = ActiveSheet Set rngCopyOfUsedRange = wsTemp.UsedRange With rngCopyOfUsedRange For i = 1 To .Cells.Count .Cells(i).Value = wsSourceWorksheet.UsedRange.Cells(i).Top Next i End With GetCellProperties2 = Application.WorksheetFunction.Transpose(rngCopyOfUsedRange) Application.DisplayAlerts = False wsTemp.Delete Application.DisplayAlerts = True Set wsTemp = Nothing Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Function 
+3
source

I would add @Doug the following

 Dim r as Range Dim data() as Variant, i as Integer Set r = Sheet1.Range("A2").Resize(100,1) data = r.Value ' Alternatively initialize an empty array with ' ReDim data(1 to 100, 1 to 1) For i=1 to 100 data(i,1) = ... Next i r.Value = data 

which shows the basic process of getting a range into an array and vice versa.

-1
source

All Articles