我喜欢这个函数的高效性。不幸的是，我希望该函数返回一个从零开始的数组！有什么建议吗？我已经尝试了 Option Base 0（虽然这是默认的）。
Function getWSarr(pWs As Worksheet) As Variant
getWSarr = pWs.UsedRange.Value
End Function
5个回答
2
与UsedRange一起工作让我想到你总是在处理一个二维数组
因此，只需将2D基于1的数组值粘贴到正确大小的基于0的2D数组中：
Function getWSarr(pWs As Worksheet) As Variant
Dim arr1 As Variant, arr0 As Variant
Dim nRows As Long, nCols As Long, i As Long, j As Long
arr1 = pWs.UsedRange.Value
nRows = UBound(arr1, 1) - 1
nCols = UBound(arr1, 2) - 1
ReDim arr0(0 To nRows, 0 To nCols)
For i = 0 To nRows
For j = 0 To nCols
arr0(i, j) = arr1(i + 1, j + 1)
Next
Next
getWSarr = arr0
End Function
- DisplayName
2
我认为最安全和最简单的方法就是将这些值循环到一个以零为基础的数组中。
不过你也可以尝试一些来自WinAPI的内存复制操作:
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function MultiDimOneToZeroArray(ByVal s As Variant) As Variant
'Do your own check first that s is a one-based array etc
''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim arr() As Variant
ReDim arr(0 To UBound(s) - 1, 0 To UBound(s, 2) - 1)
CopyMemory ByVal VarPtr(arr(0, 0)), ByVal VarPtr(s(1, 1)), UBound(s) * UBound(s, 2) * 16
MultiDimOneToZeroArray = arr
End Function
像这样来调用:
Sub test()
Dim s() As Variant
s = Sheet1.Range("A1:E20").Value2
Dim arr As Variant
arr = MultiDimOneToZeroArray(s)
End Sub
显然，您可以这样包装您的函数： ```python 显然，您可以这样包装您的函数： ```
Function getZeroBasedWSarr(pWs As Worksheet) As Variant
getZeroBasedWSarr = MultiDimOneToZeroArray(pWs.UsedRange.Value)
End Function
- MacroMarc
1
感谢您也展示了不同的方法，这不仅证明了“条条大路通罗马”的道理，而且让我们在这个网站上不断学习。+1 - T.M.
2
无法完成。无论您是处理单列或单行还是多列和/或多行，从工作表单元格检索值到变量数组中始终返回一个基于1的2-D数组。
无论如何，“Option Base 0”（在任何情况下都是默认值）都不能更改此行为。
注意：应用一次或两次转置函数可以返回单列或单行的基于0的1-D数组。
选项1：只需即时转换数组即可。
选项二：按接收到的值转置
请注意，在选项2中，当将单列行转换为1-D数组时，您只需进行一次转置。但是，当将单行列转换为1-D数组时，您需要进行两次转置。
请注意，转置具有有符号或无符号整数溢出限制的功能极限（我现在记不清是哪一个了）。
无论如何，“Option Base 0”（在任何情况下都是默认值）都不能更改此行为。
注意：应用一次或两次转置函数可以返回单列或单行的基于0的1-D数组。
选项1：只需即时转换数组即可。
dim arr1 as variant, arr2 as variant, i as long
'for multiple row values in a single column
arr1 = range("a1:a9").value
redim arr2(lbound(arr1, 1) - 1)
for i = lbound(arr1, 1) to ubound(arr1, 1)
arr2(i-1) = arr1(i, 1)
next i
for i=lbound(arr2) to ubound(arr2)
debug.print i
debug.print arr2(i)
next i
'for multiple column values in a single row
arr1 = range("a1:i1").value
redim arr2(lbound(arr1, 2) - 1)
for i = lbound(arr1, 2) to ubound(arr1, 2)
arr2(i-1) = arr1(i, 2)
next i
for i=lbound(arr2) to ubound(arr2)
debug.print i
debug.print arr2(i)
next i
选项二：按接收到的值转置
dim arr as variant
arr = application.transpose(range("a1:a9").value)
for i=lbound(arr) to ubound(arr)
debug.print i
debug.print arr(i)
next i
arr = application.transpose(application.transpose(range("a1:i1).value))
for i=lbound(arr) to ubound(arr)
debug.print i
debug.print arr(i)
next i
请注意，在选项2中，当将单列行转换为1-D数组时，您只需进行一次转置。但是，当将单行列转换为1-D数组时，您需要进行两次转置。
请注意，转置具有有符号或无符号整数溢出限制的功能极限（我现在记不清是哪一个了）。
- user10829321
1
从One到Zero的转换
Sub OneToZeroBased()
Const cStrSheet As Variant = "Sheet1" ' Worksheet Name/Index
Dim vntSrc As Variant ' Source Array
Dim vntTgt As Variant ' Target Array
Dim i As Long ' Row Counter
Dim j As Integer ' Column Counter
With Worksheets(cStrSheet)
If .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) _
Is Nothing Then Exit Sub
vntSrc = .Range(.Cells(.Cells.Find("*", _
.Cells(.Rows.Count, .Columns.Count)).Row, .Cells.Find("*", _
.Cells(.Rows.Count, .Columns.Count), , , 2).Column), .Cells(.Cells _
.Find("*", , , , 1, 2).Row, .Cells.Find("*", , , , 2, 2).Column)) _
.Value
End With
ReDim vntTgt(UBound(vntSrc, 1) - 1, UBound(vntSrc, 2) - 1)
For i = 1 To UBound(vntSrc)
For j = 1 To UBound(vntSrc, 2)
vntTgt(i - 1, j - 1) = vntSrc(i, j)
' Debug.Print i - 1 & " " & j - 1 & " " & vntTgt(i - 1, j - 1)
Next
Next
End Sub
- VBasic2008
1
不使用循环的替代方法
是的，可以通过对UserForm中的.List属性进行巧妙赋值来改变数组基数，该属性接受一个以1为基数的数组作为输入，但默认返回一个以0为基数的数组列表。（辅助函数transformArray会临时创建一个用户窗体，以允许对列表框控件进行所述的使用）。
调用代码示例
Sub ChangeBase()
' Calling example as one liner
Dim v
v = transformArray(getWSarr(ThisWorkbook.Worksheets("MySheet"))) ' <~~ change to your sheet name
End Sub
只是以防你更喜欢两个逻辑步骤：
Sub ChangeBase()
' Calling example in two steps (of course you can reduce this to a one liner, see above :-)
Dim vOne, vZero
'[1] Get 1-based 2-dim array from used range in given sheet using OP's function getWSarr
vOne = getWSarr(ThisWorkbook.Worksheets("MySheet")) ' <~~ change to your sheet name
'[2] transform to 0-based array
vZero = transformArray(vOne)
End Sub
辅助函数
Function transformArray(ByRef v) As Variant()
' Purpose: return zero-based array instead of 1-based input array
' Method: use the fact that ListBox.List returns a zero based array, but accepts 1-based arrays for import
' Ref.: "Microsoft Forms 2.0 Object Library" - MSForms (FM20.dll),
' "Microsoft Visual Basic for Applications Extensibility 5.3" - VBIDE (VBE6EXT.OLB)
Dim myForm As Object
Dim NewListBox As MSForms.ListBox
' Add temporary UserForm
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3) ' Add UserForm
' Create temporary ListBox
Set NewListBox = myForm.designer.Controls.Add("Forms.listbox.1")
With NewListBox
.ColumnCount = UBound(v, 2) + 1 ' define column count
.List = v ' fill listbox with 1-based original array
' ~~~~~~~~~~~~~~~~~~~~~~~~
' Return transformed array
' ~~~~~~~~~~~~~~~~~~~~~~~~
transformArray = .List ' <~~ return transformed array
End With
'Delete the never shown form
ThisWorkbook.VBProject.VBComponents.Remove myForm
End Function
Function getWSarr(pWs As Worksheet) As Variant
' Note: identical function as used in original post (OP)
' Purpose: get 1-based 2-dim array from used range in a given worksheet
getWSarr = pWs.UsedRange.Value
End Function
- T.M.
网页内容由stack overflow 提供, 点击上面的可以查看英文原文，
原文链接
原文链接
ListBox.List属性）- @philipsK - T.M.