Answer 1

托德，

我能想到的最佳解决方案是将顶部转储到一个范围内，然后将这些范围值转储到变量数组中。正如你所说，For Next（在我的测试中为10,000个单元）花了几秒钟。所以我创建了一个函数，它返回它输入的单元格的顶部。 下面的代码主要是一个功能，它复制您传递给它的工作表的使用范围，然后将上述功能输入到复制工作表的已用范围的每个单元格中。然后它将该范围转换并转储到变量数组中。

10,000个细胞只需要一秒左右。不知道它是否有用，但这是一个有趣的问题。如果它很有用，你可以为每个属性创建一个单独的函数或传递你正在寻找的属性，或者返回四个数组（？）......

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的请求时，我只能提供接近您开始使用的解决方案。对于10,000个细胞，它需要大约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

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

显示了将范围放入数组然后再返回的基本过程。