我喜欢此功能的效率。不幸的是,我希望函数返回一个从零开始的数组!有什么建议么?我已经尝试过Option Base 0
(尽管这是默认设置)。
Function getWSarr(pWs As Worksheet) As Variant
getWSarr = pWs.UsedRange.Value
End Function
答案 0 :(得分:2)
无法完成。从工作表的单元格中检索值到变量数组中始终会返回基于1的二维数组,而不管您是要处理的是单列还是单行还是多列和/或多行。>
Option Base 0
(在任何情况下均为默认设置)无法更改此行为。
注意事项:Application.Transpose应用一次或两次可以返回一维或零列的单列或单行。
选项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
选项2:在接收到值时转置它们
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 :(得分:2)
使用UsedRange
使我觉得您一直在处理2D阵列
因此只需将基于2D 1的数组值粘贴到适当大小的基于2D 0的数组中:
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
答案 2 :(得分: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
很明显,您可以将函数包装为:
Function getZeroBasedWSarr(pWs As Worksheet) As Variant
getZeroBasedWSarr = MultiDimOneToZeroArray(pWs.UsedRange.Value)
End Function
答案 3 :(得分:1)
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
答案 4 :(得分:1)
不带循环的替代
是,可以通过在中将 .List
的Listbox
属性的棘手分配来更改数组基数UserForm ,它接受基于1的数组作为 Input ,但默认情况下返回基于 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