2012-07-29 3 views
1

내 질문은 간단합니다. 참조로 VBA에서 배열의 두 부분을 검색하려면 C++에서와 같이 할 수 있습니까? C++로 코딩 한 이후로 꽤 오래되었습니다. 그래서 지금 당장 어떻게하는지 기억하지 못합니다. 어쩌면 내가 기억한다면, 나는 모범을 보일 것이다.참조에 의한 부분 배열

하나의 Double-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) 

물론 이것은 단지 추상적 인 설명입니다.

이미이 문제를 다루는 질문이 있으면 사과드립니다. 찾지 못했습니다.

답변

5

예, 가능합니다. 그래도 SAFEARRAY 서술자를 수동으로 만들어야 만 원본 배열 데이터의 하위 집합을 가리킬 수 있습니다.

Module1의 :

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 

모듈 2 :

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) 

문자열의 배열에 대한 배열 (StrArrPtr에 맞게 올바른 ArrPtr 맛을 사용해야합니다, UDTArrPtr 사용자 정의 유형 배열 01 다른 모든 항목의 경우).

원본 배열 변수가 erase 또는 범위를 벗어나 파괴되기 전에 수동으로 자식 배열을 파괴해야합니다.


그러나, 단지 서브 루틴을 참조하여, 전체 어레이를 통과하며 처리 시작까지의 인덱스 번호를 제공하는 것이 더 간단 할 수있다.

+2

나는 이것이 복잡하다고 생각하지 않았습니다. 객체의 배열을 정렬하는 단순한 목적을 위해, 이것은 실제로 너무 복잡 할 수도 있습니다. 게다가 VB 전문가가 아니기 때문에 Basic보다 C++를 배웠습니다. 디버깅과 인터넷 검색에 많은 시간을 할애 할 것입니다. ;) 어쨌든 고마워요! +1 – Kiruse

+0

문서화되지 않은 함수'VarPtr' [here] (http://vb.mvps.org/tips/varptr.asp)에 대한 정보를 찾았습니다 – ja72

+0

@ ja72 http://support.microsoft.com/kb/199824/en-us – GSerg

관련 문제