Эффективно назначить свойства ячейки из диапазона Excel для массива в VBA / VB.NET

Question

В VBA / VB.NET вы можете назначить значения диапазона Excel массиву для более быстрого доступа / манипулирования.Есть ли способ эффективно назначить другие свойства ячейки (например, сверху, слева, ширина, высота) для массива?То есть я хотел бы сделать что-то вроде:

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

Код является частью процедуры, чтобы программно проверить, перекрывает ли изображение ячейки, которые используются в книге.Мой текущий метод итерации по ячейкам в UsedRange медленный, так как он требует многократного опроса для верхней / левой / ширины / высоты ячеек.

Обновление: Я собираюсьпродолжайте принимать ответ Дуга, поскольку он действительно работает быстрее, чем наивная итерация.В итоге я обнаружил, что не наивная итерация работает быстрее для моих целей обнаружения элементов управления, которые перекрывают заполненные содержимым ячейки .Шаги в основном:

(1) Найдите интересный набор строк в используемом диапазоне, глядя на вершины и высоты первой ячейки в каждой строке (я понимаю, что все ячейки в строке должныимеют одинаковую вершину и высоту, но не слева и ширину)

(2) Перебирайте ячейки в интересных строках и выполняйте обнаружение перекрытия, используя только левое и правое положения ячеек.

Код для поиска интересного набора строк выглядит примерно так:

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

Answer 1

Todd,

Лучшее решение, которое я мог придумать, - это сбросить вершины в диапазон, а затем сбросить эти значения диапазона в массив вариантов. Как вы сказали, «For Next» (для 10000 ячеек в моем тесте) заняло несколько секунд. Поэтому я создал функцию, которая возвращает верх ячейки, в которую она была введена. Приведенный ниже код в основном представляет собой функцию, которая копирует использованный диапазон листа, который вы передаете ему, и затем вводит описанную выше функцию в каждую ячейку используемого диапазона скопированного листа. Затем он транспонирует и сбрасывает этот диапазон в массив вариантов.

Это займет всего секунду или около того для 10000 клеток. Не знаю, полезно ли это, но это был интересный вопрос. Если это полезно, вы можете создать отдельную функцию для каждого свойства или передать искомое свойство или вернуть четыре массива (?) ...

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,

В ответ на ваш запрос на пользовательский UDF, я могу предложить только решение, близкое к тому, с чего вы начали. Это займет примерно в 10 раз больше времени для 10000 клеток. Разница в том, что ты возвращаешься к петлям через клетки.

Я запихиваю сюда свой личный конверт, так что, возможно, у кого-то будет способ получить его без пользовательского 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

Answer 2

Я бы добавил к @Doug следующее

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

, который показывает основной процесс получения диапазона в массив и обратно.