Могу ли я вернуть 0-базовый массив из ws.usedrange.value? - PullRequest
0 голосов
/ 27 декабря 2018

Мне нравится, насколько эффективна эта функция.К сожалению, я бы хотел, чтобы функция возвращала массив с нуля!Какие-либо предложения?Я уже пытался Option Base 0 (хотя это по умолчанию).

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

Ответы [ 5 ]

0 голосов
/ 28 декабря 2018

Я бы сказал, что просто зацикливание значений в массив, начинающийся с нуля, самый безопасный и простой.

Однако вы можете пошалить с некоторыми копиями памяти из 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
0 голосов
/ 27 декабря 2018

Альтернатива без циклов

Да , возможно изменить базу массива путем сложного присвоения свойству .List Listbox в UserForm , который принимает массив на основе 1 как Input , но по умолчанию возвращает список массивов с нулями по умолчанию.(Вспомогательная функция 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
0 голосов
/ 27 декабря 2018

От одного до нуля

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
0 голосов
/ 27 декабря 2018

работа с 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
0 голосов
/ 27 декабря 2018

Это нельзя сделать.Извлечение значений в вариантный массив из ячеек рабочего листа всегда возвращает двухмерный массив на основе 1 независимо от того, имеете ли вы дело с одним или несколькими столбцами или несколькими столбцами и / или строками.

Option Base 0 (который по умолчанию используется в любом случае) не может изменить это поведение.

Предостережение: Application.Transpose, примененный один или два раза, может возвратить 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

Вариант 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 транспонирование выполняется только один раз при преобразовании строк одного столбца в одномерный массив.Однако вам нужно дважды транспонировать, чтобы преобразовать столбцы одной строки в одномерный массив.

У функции Transpose есть предел переполнения целого числа со знаком или без знака (я не могу вспомнить, какой именно в данный момент).

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...