ReDim preservar para uma matriz multi-dimensional no Visual Basic 6

Estou usando o VB6 e preciso fazer um ReDim Preserve para um Multi-Dimensional Array:

Dim n, m As Integer n = 1 m = 0 Dim arrCity() As String ReDim arrCity(n, m) n = n + 1 m = m + 1 ReDim Preserve arrCity(n, m) 

Sempre que eu faço como eu escrevi, eu recebo o seguinte erro:

erro de tempo de execução 9: subscrito fora do intervalo

Porque eu só posso mudar a última dimensão da matriz, bem na minha tarefa eu tenho que mudar toda a matriz (2 dimensões no meu exemplo)!

Existe alguma solução alternativa ou outra solução para isso?

Como você aponta corretamente, pode-se ReDim Preserve apenas a última dimensão de uma matriz ( Instrução ReDim no MSDN):

Se você usar a palavra-chave Preservar, poderá resize apenas a última dimensão da matriz e não poderá alterar o número de dimensões. Por exemplo, se sua matriz tiver apenas uma dimensão, você poderá resize essa dimensão porque ela é a última e única dimensão. No entanto, se sua matriz tiver duas ou mais dimensões, você poderá alterar o tamanho apenas da última dimensão e ainda preservar o conteúdo da matriz

Portanto, a primeira questão a ser decidida é se a matriz bidimensional é a melhor estrutura de dados para o trabalho. Talvez, o array unidimensional seja o melhor ajuste que você precisa para fazer o ReDim Preserve ?

Outra maneira é usar o arranjo irregular de acordo com a sugestão de Pieter Geerkens . Não há suporte direto para matrizes recortadas no VB6. Uma maneira de codificar “matriz de matrizes” no VB6 é declarar uma matriz de Variant e fazer de cada elemento uma matriz do tipo desejado ( String no seu caso). O código de demonstração está abaixo.

Outra opção é implementar o Preserve part on your own. Para isso, você precisará criar uma cópia dos dados a serem preservados e, em seguida, preencher a matriz redimensionada com ela.

 Option Explicit Public Sub TestMatrixResize() Const MAX_D1 As Long = 2 Const MAX_D2 As Long = 3 Dim arr() As Variant InitMatrix arr, MAX_D1, MAX_D2 PrintMatrix "Original array:", arr ResizeMatrix arr, MAX_D1 + 1, MAX_D2 + 1 PrintMatrix "Resized array:", arr End Sub Private Sub InitMatrix(a() As Variant, n As Long, m As Long) Dim i As Long, j As Long Dim StringArray() As String ReDim a(n) For i = 0 To n ReDim StringArray(m) For j = 0 To m StringArray(j) = i * (m + 1) + j Next j a(i) = StringArray Next i End Sub Private Sub PrintMatrix(heading As String, a() As Variant) Dim i As Long, j As Long Dim s As String Debug.Print heading For i = 0 To UBound(a) s = "" For j = 0 To UBound(a(i)) s = s & a(i)(j) & "; " Next j Debug.Print s Next i End Sub Private Sub ResizeMatrix(a() As Variant, n As Long, m As Long) Dim i As Long Dim StringArray() As String ReDim Preserve a(n) For i = 0 To n - 1 StringArray = a(i) ReDim Preserve StringArray(m) a(i) = StringArray Next i ReDim StringArray(m) a(n) = StringArray End Sub 

Como o VB6 é muito semelhante ao VBA, acho que posso ter uma solução que não requeira tanto código para ReDim uma matriz bidimensional – usando Transpose .

A solução (VBA):

 Dim n, m As Integer n = 2 m = 1 Dim arrCity() As Variant ReDim arrCity(1 To n, 1 To m) m = m + 1 ReDim Preserve arrCity(1 To n, 1 To m) arrCity = Application.Transpose(arrCity) n = n + 1 ReDim Preserve arrCity(1 To m, 1 To n) arrCity = Application.Transpose(arrCity) 

O que é diferente da pergunta do OP: o limite inferior do array arrCity não é 0, mas 1. Isso é para permitir que o Application.Transpose faça o trabalho.

Eu acho que você deveria ter o método Transpose no VB6.

Em relação a isso:

“na minha tarefa eu tenho que mudar toda a matriz (2 dimensões”

Basta usar uma matriz irregular (ou seja, uma matriz de matrizes de valores). Então você pode mudar as dimensões como quiser. Um pouco mais de trabalho, talvez, mas uma solução.

Eu não testei cada uma dessas respostas, mas você não precisa usar funções complicadas para conseguir isso. É muito mais fácil que isso! Meu código abaixo funcionará em qualquer aplicativo VBA do Office (Word, Access, Excel, Outlook, etc.) e é muito simples. Espero que isto ajude:

 ''Dimension 2 Arrays Dim InnerArray(1 To 3) As Variant ''The inner is for storing each column value of the current row Dim OuterArray() As Variant ''The outer is for storing each row in Dim i As Byte i = 1 Do While i <= 5 ''Enlarging our outer array to store a/another row ReDim Preserve OuterArray(1 To i) ''Loading the current row column data in InnerArray(1) = "My First Column in Row " & i InnerArray(2) = "My Second Column in Row " & i InnerArray(3) = "My Third Column in Row " & i ''Loading the entire row into our array OuterArray(i) = InnerArray i = i + 1 Loop ''Example print out of the array to the Intermediate Window Debug.Print OuterArray(1)(1) Debug.Print OuterArray(1)(2) Debug.Print OuterArray(2)(1) Debug.Print OuterArray(2)(2) 

Você pode usar um tipo definido pelo usuário contendo um array de strings que será o array interno. Em seguida, você pode usar uma matriz desse tipo definido pelo usuário como sua matriz externa.

Dê uma olhada no seguinte projeto de teste:

 '1 form with: ' command button: name=Command1 ' command button: name=Command2 Option Explicit Private Type MyArray strInner() As String End Type Private mudtOuter() As MyArray Private Sub Command1_Click() 'change the dimensens of the outer array, and fill the extra elements with "1" Dim intOuter As Integer Dim intInner As Integer Dim intOldOuter As Integer intOldOuter = UBound(mudtOuter) ReDim Preserve mudtOuter(intOldOuter + 2) As MyArray For intOuter = intOldOuter + 1 To UBound(mudtOuter) ReDim mudtOuter(intOuter).strInner(intOuter) As String For intInner = 0 To UBound(mudtOuter(intOuter).strInner) mudtOuter(intOuter).strInner(intInner) = "1" Next intInner Next intOuter End Sub Private Sub Command2_Click() 'change the dimensions of the middle inner array, and fill the extra elements with "2" Dim intOuter As Integer Dim intInner As Integer Dim intOldInner As Integer intOuter = UBound(mudtOuter) / 2 intOldInner = UBound(mudtOuter(intOuter).strInner) ReDim Preserve mudtOuter(intOuter).strInner(intOldInner + 5) As String For intInner = intOldInner + 1 To UBound(mudtOuter(intOuter).strInner) mudtOuter(intOuter).strInner(intInner) = "2" Next intInner End Sub Private Sub Form_Click() 'clear the form and print the outer,inner arrays Dim intOuter As Integer Dim intInner As Integer Cls For intOuter = 0 To UBound(mudtOuter) For intInner = 0 To UBound(mudtOuter(intOuter).strInner) Print CStr(intOuter) & "," & CStr(intInner) & " = " & mudtOuter(intOuter).strInner(intInner) Next intInner Print "" 'add an empty line between the outer array elements Next intOuter End Sub Private Sub Form_Load() 'init the arrays Dim intOuter As Integer Dim intInner As Integer ReDim mudtOuter(5) As MyArray For intOuter = 0 To UBound(mudtOuter) ReDim mudtOuter(intOuter).strInner(intOuter) As String For intInner = 0 To UBound(mudtOuter(intOuter).strInner) mudtOuter(intOuter).strInner(intInner) = CStr((intOuter + 1) * (intInner + 1)) Next intInner Next intOuter WindowState = vbMaximized End Sub 

Execute o projeto e clique no formulário para exibir o conteúdo das matrizes.

Clique no Command1 para ampliar o array externo e clique no formulário novamente para mostrar os resultados.

Clique no Command2 para ampliar uma matriz interna e clique no formulário novamente para mostrar os resultados.

Tenha cuidado, porém: quando você redimir o array externo, você também precisa redimir os arrays internos para todos os novos elementos do array externo

Eu tropecei nessa questão enquanto batia neste bloqueio na estrada. Acabei escrevendo um trecho de código realmente rápido para lidar com este ReDim Preserve em uma nova matriz de tamanho (primeira ou última dimensão). Talvez isso ajude outras pessoas que enfrentam o mesmo problema.

Então, para o uso, digamos que você tenha seu array originalmente definido como MyArray(3,5) , e você quer fazer as dimensões (primeiro também!) Maiores, vamos apenas dizer para MyArray(10,20) . Você estaria acostumado a fazer algo assim certo?

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

Mas infelizmente isso retorna um erro porque você tentou mudar o tamanho da primeira dimensão. Então, com a minha function, você faria algo assim:

  MyArray = ReDimPreserve(MyArray,10,20) 

Agora a matriz é maior e os dados são preservados. Seu ReDim Preserve para um array Multi-Dimension está completo. 🙂

E por último mas não menos importante, a function milagrosa: 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 

Eu escrevi isso em 20 minutos, então não há garantias. Mas se você quiser usá-lo ou estendê-lo, fique à vontade. Eu teria pensado que alguém já teria algum código como este aqui em cima, bem, aparentemente não. Então aqui você vai colegas de trabalho.

Isso é mais compacto e respeita a primeira posição inicial na matriz e apenas usa o limite inicial para adicionar valor antigo.

 Public Sub ReDimPreserve(ByRef arr, ByVal size1 As Long, ByVal size2 As Long) Dim arr2 As Variant Dim x As Long, y As Long 'Check if it's an array first If Not IsArray(arr) Then Exit Sub 'create new array with initial start ReDim arr2(LBound(arr, 1) To size1, LBound(arr, 2) To size2) 'loop through first For x = LBound(arr, 1) To UBound(arr, 1) For y = LBound(arr, 2) To UBound(arr, 2) 'if its in range, then append to new array the same way arr2(x, y) = arr(x, y) Next Next 'return byref arr = arr2 End Sub 

Eu chamo este sub com esta linha para resize a primeira dimensão

 ReDimPreserve arr2, UBound(arr2, 1) + 1, UBound(arr2, 2) 

Você pode adicionar outro teste para verificar se o tamanho inicial não é superior ao novo array. No meu caso não é necessário

Eu sei que isso é um pouco antigo, mas acho que pode haver uma solução muito mais simples que não requer codificação adicional:

Em vez de transpor, redimir e transpor novamente, e se falamos de uma matriz bidimensional, por que não apenas armazenar os valores transpostos para começar? Nesse caso, a redim preserve realmente aumenta a dimensão certa (segunda) desde o início. Ou, em outras palavras, para visualizá-lo, por que não armazenar em duas linhas em vez de duas colunas, se apenas o número de colunas puder ser aumentado com preservação de redim.

os índices deveriam ser 00-01, 01-11, 02-12, 03-13, 04-14, 05-15 … 0 25-1 25 etcetera em vez de 00-01, 10-11, 20-21 30-31, 40-41, etc.

Enquanto houver apenas uma dimensão que precise ser preservada, a abordagem ainda funcionaria: basta colocar essa dimensão por último.

Como apenas a segunda (ou última) dimensão pode ser preservada durante o redimming, talvez se possa argumentar que é assim que as matrizes devem ser usadas para começar. Eu não vi essa solução em nenhum lugar, então talvez eu esteja negligenciando alguma coisa?

(Postado anteriormente em questão semelhante sobre duas dimensões, estendida resposta aqui para mais dimensões)