从一对零开始

Question

我喜欢此功能的效率。不幸的是，我希望函数返回一个从零开始的数组！有什么建议么？我已经尝试过Option Base 0（尽管这是默认设置）。

Function getWSarr(pWs As Worksheet) As Variant
    getWSarr = pWs.UsedRange.Value
End Function

Answer 1

无法完成。从工作表的单元格中检索值到变量数组中始终会返回基于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中，将单列的行转换为一维数组时仅转置一次。但是，您需要转置两次才能将单行的列转换为一维数组。

转置的功能限制是有符号或无符号整数的溢出限制（我现在不记得是哪个）。

Answer 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

Answer 3

我想说，简单地将值循环到基于零的数组中是最安全，最简单的。

但是，您可以在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

Answer 4

从一对零开始

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

Answer 5

不带循环的替代

是，可以通过在中将 .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

我可以从ws.usedrange.value返回一个0基数组吗？

5 个答案:

从一对零开始