从Excel范围有效地分配单元格属性到VBA / VB.NET中的一个数组
在VBA / VB.NET中，您可以将Excel范围值分配给数组，以便更快地访问/操作。 有没有办法有效地将其他单元格属性（例如，顶部，左侧，宽度，高度）分配给一个数组？ 也就是说，我想要做一些事情：
Dim cellTops As Variant : cellTops = Application.ActiveSheet.UsedRange.Top 该代码是程序的一部分，以编程方式检查图像是否与工作簿中使用的单元格重叠。 我目前使用UsedRange中的单元格的方法很慢，因为它需要反复轮询单元格的顶部/左侧/宽度/高度。
更新：我将继续接受道格的答案，因为它的确工作得比天真的迭代更快。 最后，我发现一个非天真的迭代工作更快，我的目的是检测重叠内容填充单元格的控件 。 步骤基本上是：
（1）通过查看每行中第一个单元格的顶部和高度来find所使用的范围中有趣的一组行（我的理解是行中的所有单元格必须具有相同的顶部和高度，宽度）
（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
托德，
我能想到的最好的解决scheme是将顶部转储到一个范围内，然后将这些范围值转储到variables数组中。 正如你所说的，For Next（在我的testing中有10,000个单元格）花了几秒钟。 所以我创build了一个函数，返回它input的单元格的顶部。 下面的代码主要是一个函数，它复制您传递给它的工作表的使用范围，然后将上述函数input到复制工作表的使用范围的每个单元格中。 然后它将该范围转换并转储到变体数组中。
10,000个细胞只需要一秒左右。 不知道它是否有用，但这是一个有趣的问题。 如果它是有用的，你可以为每个属性创build一个单独的函数或传递你正在寻找的属性，或者返回四个数组（？）…
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
托德，
在回答您对非定制UDF的请求时，我只能提供一个与您开始的解决scheme接近的解决scheme。 10000个电池需要10倍的时间。 不同之处在于你回到了循环单元格。
我在这里推动我的个人信封，所以也许有人会有办法去没有自定义的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
我会添加到@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
它显示了将一个范围变成一个数组并返回的基本过程。