May I return a 0-base array from ws.usedrange.valu

问题:

I like how efficient this function is. Unfortunately I wish the function returned a zero-based array! Any suggestions? I've attempted Option Base 0 already (although that is the default).

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

回答1:

I'd say simply looping the values into a zero-based array is safest & simplest.

You could however fool around with some memory-copy stuff from 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

Call it like so:

Sub test()
    Dim s() As Variant
    s = Sheet1.Range("A1:E20").Value2

    Dim arr As Variant
    arr = MultiDimOneToZeroArray(s)

End Sub

Obviously you can wrap your func so:

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

回答2:

It cannot be done. Retrieving values into an variant array from the worksheet's cells always returns a 1-based 2-D array regardless of whether you are dealing with a single column or single row or multiple columns and/or rows.

Option Base 0 (which is the default in any case) cannot change this behavior.

Caveat: Application.Transpose applied once or twice can return a 1-D zero-based array of a single column or single row.

Option 1: Simply convert the array on the fly

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

Option 2: Transpose the values as they are received

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

Note that in Option 2 you only transpose once when converting a single column's rows into a 1-D array. However, you need to transpose twice to convert a single row's columns into a 1-D array.

Transpose has a functional limit of either a signed or unsigned integer's overflow limit (I cannot remember which at the moment).

回答3:

working with a UsedRange makes me think you're always dealing with a 2D array

so just paste the 2D 1-based array values into a properly sized 2D 0-based one:

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

回答4:

One to Zero Based

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

回答5:

Alternative without Loops

Yes, it's possible to change the array base via a tricky assignment to the .List property of a Listbox in a UserForm, which accepts a 1-based array as Input, but returns a zero-based array list by default. (The helper function transformArray creates a temporary userform on the fly just to allow the described use of a listbox control).

Calling code example

Sub ChangeBase()
' Calling example as one liner
 Dim v
 v = transformArray(getWSarr(ThisWorkbook.Worksheets("MySheet")))   ' <~~ change to your sheet name
 End Sub

Just in case you prefer two logical steps:

  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

Helper functions

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