Excel VBA - 将范围读入变体,同时保持索引与列号相同
Excel VBA - Read range into Variant while maintaining index same as column numbers
我正在 Excel 2013 年写一个 vba 宏。我有下面的代码来将一个范围读入一个变体,
Dim MyBuffer As Variant
With MyWorkSheet
MyBuffer = .Range(.Cells(1, NAME_COL), .Cells(10, AGE_COL)).Value
End With
'Here NAME_COL = 5, AGE_COL = 9
现在 MyBuffer 是一个二维数组,索引范围从 (1, 1) 到 (10, 5)。我想知道是否有办法保持索引的第二部分与列号相同。即从 (1, 5) 到 (10, 9) 以便我也可以在访问 Variant 时使用常量 NAME_COL、AGE_COL 等。这主要是为了可读性(以便其他程序员可以轻松地看到我正在访问哪个条目)和可维护性(我们 sheet 上的 add/delete/swap 列的情况)。感谢您在解决相同问题方面的任何帮助。请注意,我不考虑进一步复制到另一个具有修改索引的数组,或者为变量位置设置另一组常量(NAME_POS、AGE_POS 等)。
重新调一下。
With MyWorkSheet
MyBuffer = .Range(.Cells(1, NAME_COL), .Cells(10, AGE_COL)).Value
ReDim Preserve MyBuffer(LBound(MyBuffer) To UBound(MyBuffer), NAME_COL To AGE_COL)
End With
根据GSerg的建议,我做了以下测试来衡量性能以及内存地址的变化。
// Shift column indices, without increasing number of columns
1000R x 20C --> 1000R x 20C = 4.7 micro secs (address remains same)
100,000R x 20C --> 100,000R x 20C = 6.3 micro secs (address remains same)
// Shift column indices, and increase number of columns
1000R x 20C --> 1000R x 21C = 80 micro secs (address changes)
100,000R x 20C --> 100,000R x 21C = 13.5 milli secs (address changes)
代码如下,有兴趣的朋友
Option Explicit
Declare Function GetFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (Frequency As Currency) As Long
Declare Function GetTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (TickCount As Currency) As Long
Sub Test()
Dim MyWorkSheet As Worksheet
Dim MyBuffer As Variant
Dim FirstRow As Long
Dim FirstCol As Long
Dim LastRow As Long
Dim LastCol As Long
Dim Message As String
Set MyWorkSheet = Sheets("Test")
FirstRow = 1
FirstCol = 1
LastRow = 100000
LastCol = 20
' Read the range into buffer
With MyWorkSheet
MyBuffer = .Range(.Cells(FirstRow, FirstCol), .Cells(LastRow, LastCol)).Value
End With
' Check the address before ReDim
Message = "Value At " & VarPtr(MyBuffer(FirstRow, FirstCol)) & " = " & MyBuffer(FirstRow, FirstCol)
' Shift the column indices
FirstCol = FirstCol + 100
LastCol = LastCol + 100 ' Modify this to change column count as well
' ReDim the buffer to shifted column indices and measure time taken
Timer
ReDim Preserve MyBuffer(FirstRow To LastRow, FirstCol To LastCol)
Timer
' Check the address after ReDim
Message = Message & Chr(10) & "Value At " & VarPtr(MyBuffer(FirstRow, FirstCol)) & " = " & MyBuffer(FirstRow, FirstCol)
MsgBox Message
End Sub
Sub Timer()
Dim TickCount As Currency
GetTickCount TickCount
Static Frequency As Currency
If Frequency = 0 Then
GetFrequency Frequency
End If
Static FirstTime As Double
If Frequency Then
If FirstTime <> 0 Then
MsgBox "Elapsed : " & (TickCount / Frequency) - FirstTime
FirstTime = 0
Else
FirstTime = TickCount / Frequency
End If
End If
End Sub
我正在 Excel 2013 年写一个 vba 宏。我有下面的代码来将一个范围读入一个变体,
Dim MyBuffer As Variant
With MyWorkSheet
MyBuffer = .Range(.Cells(1, NAME_COL), .Cells(10, AGE_COL)).Value
End With
'Here NAME_COL = 5, AGE_COL = 9
现在 MyBuffer 是一个二维数组,索引范围从 (1, 1) 到 (10, 5)。我想知道是否有办法保持索引的第二部分与列号相同。即从 (1, 5) 到 (10, 9) 以便我也可以在访问 Variant 时使用常量 NAME_COL、AGE_COL 等。这主要是为了可读性(以便其他程序员可以轻松地看到我正在访问哪个条目)和可维护性(我们 sheet 上的 add/delete/swap 列的情况)。感谢您在解决相同问题方面的任何帮助。请注意,我不考虑进一步复制到另一个具有修改索引的数组,或者为变量位置设置另一组常量(NAME_POS、AGE_POS 等)。
重新调一下。
With MyWorkSheet
MyBuffer = .Range(.Cells(1, NAME_COL), .Cells(10, AGE_COL)).Value
ReDim Preserve MyBuffer(LBound(MyBuffer) To UBound(MyBuffer), NAME_COL To AGE_COL)
End With
根据GSerg的建议,我做了以下测试来衡量性能以及内存地址的变化。
// Shift column indices, without increasing number of columns
1000R x 20C --> 1000R x 20C = 4.7 micro secs (address remains same)
100,000R x 20C --> 100,000R x 20C = 6.3 micro secs (address remains same)
// Shift column indices, and increase number of columns
1000R x 20C --> 1000R x 21C = 80 micro secs (address changes)
100,000R x 20C --> 100,000R x 21C = 13.5 milli secs (address changes)
代码如下,有兴趣的朋友
Option Explicit
Declare Function GetFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (Frequency As Currency) As Long
Declare Function GetTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (TickCount As Currency) As Long
Sub Test()
Dim MyWorkSheet As Worksheet
Dim MyBuffer As Variant
Dim FirstRow As Long
Dim FirstCol As Long
Dim LastRow As Long
Dim LastCol As Long
Dim Message As String
Set MyWorkSheet = Sheets("Test")
FirstRow = 1
FirstCol = 1
LastRow = 100000
LastCol = 20
' Read the range into buffer
With MyWorkSheet
MyBuffer = .Range(.Cells(FirstRow, FirstCol), .Cells(LastRow, LastCol)).Value
End With
' Check the address before ReDim
Message = "Value At " & VarPtr(MyBuffer(FirstRow, FirstCol)) & " = " & MyBuffer(FirstRow, FirstCol)
' Shift the column indices
FirstCol = FirstCol + 100
LastCol = LastCol + 100 ' Modify this to change column count as well
' ReDim the buffer to shifted column indices and measure time taken
Timer
ReDim Preserve MyBuffer(FirstRow To LastRow, FirstCol To LastCol)
Timer
' Check the address after ReDim
Message = Message & Chr(10) & "Value At " & VarPtr(MyBuffer(FirstRow, FirstCol)) & " = " & MyBuffer(FirstRow, FirstCol)
MsgBox Message
End Sub
Sub Timer()
Dim TickCount As Currency
GetTickCount TickCount
Static Frequency As Currency
If Frequency = 0 Then
GetFrequency Frequency
End If
Static FirstTime As Double
If Frequency Then
If FirstTime <> 0 Then
MsgBox "Elapsed : " & (TickCount / Frequency) - FirstTime
FirstTime = 0
Else
FirstTime = TickCount / Frequency
End If
End If
End Sub