部分數組引用

Question

我的問題很簡單：像我在C++中那樣，可以通過引用檢索VBA中的數組的兩個部分嗎？我用C++編碼已經有一段時間了，所以我現在還記不起我是怎麼做的。也許如果我記得，我會舉一個例子。

我所試圖做的是那種由單一雙type屬性對象的數組。我以前在C++中完成過，只是沒有源代碼了。

我懷疑有使用這個預定義的功能，但如果有人知道一個更好的解決方案，它會受到極大的歡迎。 ;）

這基本上就是我想要的：

source array(0, 1, 2, 3, 4, 5) 

split source array in two 
array a(0, 1, 2) 
array b(3, 4, 5) 

set array a(0) = 4 
array a(4, 1, 2) 
array b(3, 4, 5) 
source array(4, 1, 2, 3, 4, 5) 

當然，這只是一個抽象描述。

我道歉，如果已經有處理這個問題，我當時還沒有發現它。

Answer 1

是的，你可以。您將不得不手動構建一個SAFEARRAY描述符，以便它指向原始數組的數據的子集。

模塊1：

Public Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long 
Public Declare Function PutMem4 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long 
Public Declare Function PutMem8 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValueLow As Long, ByVal NewValueHigh As Long) As Long 

單詞數：

Private Declare Function SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ppsaOut As Any) As Long 
Private Declare Function SafeArrayDestroyDescriptor Lib "oleaut32" (psa As Any) As Long 

Private Const S_OK As Long = 0 

Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long 

Public Function StrArrPtr(arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long 
    GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr) 
End Function 

Public Function UDTArrPtr(ByRef arr As Variant) As Long 
    If VarType(arr) Or vbArray Then 
    GetMem4 VarPtr(arr) + 8, VarPtr(UDTArrPtr) 
    Else 
    Err.Raise 5, , "Variant must contain array of user defined type" 
    End If 
End Function 


Public Function CreateSAFEARRAY(ByVal ppBlankArr As Long, ByVal ElemSize As Long, ByVal pData As Long, ParamArray Bounds()) As Long 

'ParamArray Bounds describes desired array dimensions in VB style 
'bounds(0) - lower bound of first dimension 
'bounds(1) - upper bound of first dimension 
'bounds(2) - lower bound of second dimension 
'bounds(3) - upper bound of second dimension 
'etc 

    Dim i As Long 

    If (UBound(Bounds) - LBound(Bounds) + 1) Mod 2 Then Err.Raise 5, "SafeArray", "Bounds must contain even number of entries." 

    If SafeArrayAllocDescriptor((UBound(Bounds) - LBound(Bounds) + 1)/2, ByVal ppBlankArr) <> S_OK Then Err.Raise 5 

    GetMem4 ppBlankArr, VarPtr(CreateSAFEARRAY) 
    PutMem4 CreateSAFEARRAY + 4, ElemSize 
    PutMem4 CreateSAFEARRAY + 12, pData 

    For i = LBound(Bounds) To UBound(Bounds) - 1 Step 2 
    If Bounds(i + 1) - Bounds(i) + 1 > 0 Then 
     PutMem8 CreateSAFEARRAY + 16 + (UBound(Bounds) - i - 1) * 4, Bounds(i + 1) - Bounds(i) + 1, Bounds(i) 
    Else 
     SafeArrayDestroyDescriptor ByVal CreateSAFEARRAY 
     CreateSAFEARRAY = 0 
     PutMem4 ppBlankArr, 0 
     Err.Raise 5, , "Each dimension must contain at least 1 element" 
    End If 
    Next 
End Function 

Public Function DestroySAFEARRAY(ByVal ppArray As Long) As Long 
    GetMem4 ppArray, VarPtr(DestroySAFEARRAY) 
    If SafeArrayDestroyDescriptor(ByVal DestroySAFEARRAY) <> S_OK Then Err.Raise 5 
    PutMem4 ppArray, 0 
    DestroySAFEARRAY = 0 
End Function 

用法：

Dim source(0 To 5) As Long 
source(0) = 0: source(1) = 1: source(2) = 2: source(3) = 3: source(4) = 4: source(5) = 5 

Dim a() As Long 
Dim b() As Long 

CreateSAFEARRAY ArrPtr(a), 4, VarPtr(source(0)), 0, 2 
CreateSAFEARRAY ArrPtr(b), 4, VarPtr(source(3)), 0, 2 

MsgBox b(0) 

a(0) = 4 

DestroySAFEARRAY ArrPtr(a) 
DestroySAFEARRAY ArrPtr(b) 

MsgBox source(0) 

一定要使用正確的ArrPtr味道，以符合您陣列（StrArrPtr爲字符串數組， UDTArrPtr用於用戶定義類型的數組01其他的一切都是）。

請務必手動摧毀孩子陣列之前的原始數組變量被通過任何erase銷燬或走出去的範圍。

---

然而，這可能是更簡單的，只是通過引用傳遞整個陣列到子程序，並且還提供從其開始處理的索引號。