Excel VBA - 2D 어레이 리딤 방법

Excel VBA - 2D 어레이 리딤 방법

Visual Basic 경유 Excel에서는 Excel에 로드된 청구서의 CSV 파일을 통해 반복하고 있습니다.청구서는 고객별로 결정 가능한 형태입니다.

동적 2D 어레이로 읽어낸 후 이전 청구서가 있는 다른 워크시트에 씁니다.배열의 마지막 차원만 리디밍된 다음 마스터 워크시트에 쓸 때 전치될 수 있으므로 행과 열을 반대로 해야 한다는 것을 이해했습니다.

어디선가 구문이 틀렸어요.어레이의 치수가 이미 설정되었다고 계속 표시됩니다.내가 정적 배열로 만든거야?동적으로 동작하려면 무엇을 수정해야 합니까?

주어진 답변당 작업 코드

Sub InvoicesUpdate()
'
'Application Settings
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

'Instantiate control variables
Dim allRows As Long, currentOffset As Long, invoiceActive As Boolean, mAllRows As Long
Dim iAllRows As Long, unusedRow As Long, row As Long, mWSExists As Boolean, newmAllRows As Long

'Instantiate invoice variables
Dim accountNum As String, custName As String, vinNum As String, caseNum As String, statusField As String
Dim invDate As String, makeField As String, feeDesc As String, amountField As String, invNum As String

'Instantiate Workbook variables
Dim mWB As Workbook 'master
Dim iWB As Workbook 'import

'Instantiate Worksheet variables
Dim mWS As Worksheet
Dim iWS As Worksheet

'Instantiate Range variables
Dim iData As Range

'Initialize variables
invoiceActive = False
row = 0

'Open import workbook
Workbooks.Open ("path:excel_invoices.csv")
Set iWB = ActiveWorkbook
Set iWS = iWB.Sheets("excel_invoices.csv")
iWS.Activate
Range("A1").Select
iAllRows = iWS.UsedRange.Rows.Count 'Count rows of import data

'Instantiate array, include extra column for client name
Dim invoices()
ReDim invoices(10, 0) 

'Loop through rows.
Do

    'Check for the start of a client and store client name
    If ActiveCell.Value = "Account Number" Then

        clientName = ActiveCell.Offset(-1, 6).Value

    End If

    If ActiveCell.Offset(0, 3).Value <> Empty And ActiveCell.Value <> "Account Number" And ActiveCell.Offset(2, 0) = Empty Then

        invoiceActive = True

        'Populate account information.
        accountNum = ActiveCell.Offset(0, 0).Value
        vinNum = ActiveCell.Offset(0, 1).Value
        'leave out customer name for FDCPA reasons
        caseNum = ActiveCell.Offset(0, 3).Value
        statusField = ActiveCell.Offset(0, 4).Value
        invDate = ActiveCell.Offset(0, 5).Value
        makeField = ActiveCell.Offset(0, 6).Value

    End If

    If invoiceActive = True And ActiveCell.Value = Empty And ActiveCell.Offset(0, 6).Value = Empty And ActiveCell.Offset(0, 9).Value = Empty Then

        'Make sure something other than $0 was invoiced
        If ActiveCell.Offset(0, 8).Value <> 0 Then

            'Populate individual item values.
            feeDesc = ActiveCell.Offset(0, 7).Value
            amountField = ActiveCell.Offset(0, 8).Value
            invNum = ActiveCell.Offset(0, 10).Value

            'Transfer data to array
            invoices(0, row) = "=TODAY()"
            invoices(1, row) = accountNum
            invoices(2, row) = clientName
            invoices(3, row) = vinNum
            invoices(4, row) = caseNum
            invoices(5, row) = statusField
            invoices(6, row) = invDate
            invoices(7, row) = makeField
            invoices(8, row) = feeDesc
            invoices(9, row) = amountField
            invoices(10, row) = invNum

            'Increment row counter for array
            row = row + 1

            'Resize array for next entry
            ReDim Preserve invoices(10,row)

         End If

    End If

    'Find the end of an invoice
    If invoiceActive = True And ActiveCell.Offset(0, 9) <> Empty Then

        'Set the flag to outside of an invoice
        invoiceActive = False

    End If

    'Increment active cell to next cell down
    ActiveCell.Offset(1, 0).Activate

'Define end of the loop at the last used row
Loop Until ActiveCell.row = iAllRows

'Close import data file
iWB.Close

이것은 직관적인 것은 아니지만, 치수로 어둡게 했을 경우는, 어레이를 리딤(VB6 Ref) 할 수 없습니다.링크된 페이지의 정확한 인용문은 다음과 같습니다.

ReDim 문은 Private, Public 또는 Dim 문을 사용하여 이미 공식적으로 선언된 동적 배열의 크기 또는 크기를 조정하기 위해 사용됩니다(차원 첨자 없음).

바꿔 말하면,dim invoices(10,0)

를 사용해 주세요.

Dim invoices()
Redim invoices(10,0)

그리고 ReDim을 사용할 때는Redim Preserve (10,row)

경고:다차원 배열 리디멘션을 수행할 때 값을 보존하려면 마지막 치수만 늘릴 수 있습니다.예.Redim Preserve (11,row)또는 심지어(11,0)실패할 거야

나는 이 도로를 직접 들이받다가 우연히 이 문제를 발견했다.이 일을 처리할 수 있는 코드를 빨리 하나 작성했어요ReDim Preserve새로운 크기의 어레이(첫 번째 치수 또는 마지막 치수)에 있습니다.어쩌면 그것은 같은 문제에 직면한 다른 사람들에게 도움이 될 것이다.

사용방법에 대해 어레이가 원래 다음과 같이 설정되어 있다고 가정합니다.MyArray(3,5)치수(처음에도!)를 크게 하고 싶다.MyArray(10,20)이런 거에 익숙하겠죠?

 ReDim Preserve MyArray(10,20) '<-- Returns Error

그러나 유감스럽게도 첫 번째 치수의 크기를 변경하려고 했기 때문에 오류가 반환됩니다.제 기능을 사용하면 다음과 같은 작업을 수행할 수 있습니다.

 MyArray = ReDimPreserve(MyArray,10,20)

이제 어레이가 커지고 데이터가 보존됩니다.당신의.ReDim Preserve(Multi-Dimension 어레이 완료):)

마지막으로, 기적적인 기능:ReDimPreserve()

'redim preserve both dimensions for a multidimension array *ONLY
Public Function ReDimPreserve(aArrayToPreserve,nNewFirstUBound,nNewLastUBound)
    ReDimPreserve = False
    'check if its in array first
    If IsArray(aArrayToPreserve) Then       
        'create new array
        ReDim aPreservedArray(nNewFirstUBound,nNewLastUBound)
        'get old lBound/uBound
        nOldFirstUBound = uBound(aArrayToPreserve,1)
        nOldLastUBound = uBound(aArrayToPreserve,2)         
        'loop through first
        For nFirst = lBound(aArrayToPreserve,1) to nNewFirstUBound
            For nLast = lBound(aArrayToPreserve,2) to nNewLastUBound
                'if its in range, then append to new array the same way
                If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
                    aPreservedArray(nFirst,nLast) = aArrayToPreserve(nFirst,nLast)
                End If
            Next
        Next            
        'return the array redimmed
        If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
    End If
End Function

한 20분 만에 썼기 때문에 장담할 수 없어요.다만, 사용이나 연장을 원하신다면, 부담없이 이용하실 수 있습니다.누군가 이미 이런 암호를 가지고 있었을 거라고 생각했겠죠. 확실히 아니죠.자, 여기 기어헤드 동무들이야.

조금 오래된 것은 알지만, 추가 코딩이 필요 없는 훨씬 더 간단한 솔루션이 있을 수 있습니다.

전치, 리다이밍, 전치 대신 2차원 배열에 대해 이야기하면 먼저 전치된 값을 저장하는 것이 어떨까요?이 경우 redim preserve는 처음부터 오른쪽(두 번째) 치수를 증가시킵니다.또는 다시 말해, 시각화하기 위해 리딤 보존으로 열의 nr만 증가할 수 있다면 두 개의 열 대신 두 개의 행에 저장하는 것이 어떨까?

지수는 00-01, 10-11, 30-31, 40-41 등이 아니라 00-01, 01-11, 02-12, 03-13, 04-14, 05-15... 0 25-1 25 등입니다.

리다이밍 중에도 두 번째(또는 마지막) 차원만 보존할 수 있기 때문에 처음에는 이렇게 어레이를 사용해야 한다고 주장할 수 있습니다.저는 이 해결책을 어디서도 본 적이 없는데, 혹시 제가 뭔가를 간과하고 있는 건 아닐까요?

다음은 redim preseve 메서드의 업데이트된 코드와 variabel 선언입니다.@Control Freak이 괜찮기를 바랍니다.

Option explicit
'redim preserve both dimensions for a multidimension array *ONLY
Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Variant, nNewLastUBound As Variant) As Variant
    Dim nFirst As Long
    Dim nLast As Long
    Dim nOldFirstUBound As Long
    Dim nOldLastUBound As Long

    ReDimPreserve = False
    'check if its in array first
    If IsArray(aArrayToPreserve) Then
        'create new array
        ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)
        'get old lBound/uBound
        nOldFirstUBound = UBound(aArrayToPreserve, 1)
        nOldLastUBound = UBound(aArrayToPreserve, 2)
        'loop through first
        For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound
            For nLast = LBound(aArrayToPreserve, 2) To nNewLastUBound
                'if its in range, then append to new array the same way
                If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
                    aPreservedArray(nFirst, nLast) = aArrayToPreserve(nFirst, nLast)
                End If
            Next
        Next
        'return the array redimmed
        If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
    End If
End Function

여기.

Public Function ReDimPreserve(ByRef Arr, ByVal idx1 As Integer, ByVal idx2 As Integer)

    Dim newArr()
    Dim x As Integer
    Dim y As Integer

    ReDim newArr(idx1, idx2)

    For x = 0 To UBound(Arr, 1)
        For y = 0 To UBound(Arr, 2)
            newArr(x, y) = Arr(x, y)
        Next
    Next

    Arr = newArr

End Function

이렇게 하는 거예요.

Dim TAV() As Variant
Dim ArrayToPreserve() as Variant

TAV = ArrayToPreserve
ReDim ArrayToPreserve(nDim1, nDim2)
For i = 0 To UBound(TAV, 1)
    For j = 0 To UBound(TAV, 2)
        ArrayToPreserve(i, j) = TAV(i, j)
    Next j
Next i

@control freak과 @skatun이 이전에 쓴 것에 대한 작은 업데이트입니다(코멘트만 할 만한 평판이 없어서 죄송합니다).skatun의 코드를 사용했는데, 필요한 것보다 더 큰 배열을 만들고 있다는 것 외에는 잘 작동했습니다.그 때문에, 다음과 같이 변경했습니다.

ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)

대상:

ReDim aPreservedArray(LBound(aArrayToPreserve, 1) To nNewFirstUBound, LBound(aArrayToPreserve, 2) To nNewLastUBound)

이것에 의해, 원래의 배열의 하한(0, 1, 또는 그 외의 것)이 양쪽 차원에 대해서 유지됩니다.원래 코드는 0을 상정하고 있습니다.

저는 이걸 좀 더 짧게 풀었어요.

Dim marray() as variant, array2() as variant, YY ,ZZ as integer
YY=1
ZZ=1

Redim marray(1 to 1000, 1 to 10)
Do while ZZ<100 ' this is populating the first array
marray(ZZ,YY)= "something"
ZZ=ZZ+1
YY=YY+1 
Loop
'this part is where you store your array in another then resize and restore to original
array2= marray
Redim marray(1 to ZZ-1, 1 to YY)
marray = array2

할 수 array(0)= array(0,1,2,3).

Sub add_new(data_array() As Variant, new_data() As Variant)
    Dim ar2() As Variant, fl As Integer
    If Not (isEmpty(data_array)) = True Then
        fl = 0
    Else
        fl = UBound(data_array) + 1
    End If
    ReDim Preserve data_array(fl)
    data_array(fl) = new_data
End Sub

Sub demo()
    Dim dt() As Variant, nw(0, 1) As Variant
    nw(0, 0) = "Hi"
    nw(0, 1) = "Bye"
    Call add_new(dt, nw)
    nw(0, 0) = "Good"
    nw(0, 1) = "Bad"
    Call add_new(dt, nw)
End Sub

언급URL : https://stackoverflow.com/questions/13183775/excel-vba-how-to-redim-a-2d-array