VBA: Resize dynamisk 2-dimensionalt array

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_20726205.html

Only the upper bound of the last dimension in a multidimensional array can be changed when you use the Preserve keyword; if you change any of the other dimensions, or the lower bound of the last dimension, a run-time error occurs. Thus, you can use code like this:

ReDim Preserve Matrix(10, UBound(Matrix, 2) + 1)
But you cannot use this code:

ReDim Preserve Matrix(UBound(Matrix, 1) + 1, 10)

Det var da ikke ret smart lavet ;|

Nå, men det er der ikke noget at gøre ved. Bare træls at skulle til at flytte data over i et nyt array op til flere tusinde gange, så den metode er heller ikke så holdbar.

Har du et forslag til en anden måde man kan gemme data midlertidigt på? De data jeg skal gemme er x antal rækker med hver 9 værdier. Kunne selvfølgelig gemme data i et nyt midlertidigt ark.

hvis jeg kan se din kode, hvor du læser ind i Arrayet, er der måske en anden løsning.

tag evt et kig her

http://www.eksperten.dk/artikler/522

kabbak: Der er ikke så meget hokus pokus i det. Åbner en tekstfil ind i Excel, og gennemløber så blot hver linie og gemmer det i array'et.

    iMaxRow = ActiveSheet.UsedRange.Rows.Count
    iSAPCount = 1
    ReDim Preserve SAPImportArray(1, 9) 'Første gang, så ingen problemer!
    For iRow = 1 To iMaxRow
      SAPImportArray(iSAPCount, 1) = Cells(iRow, 5).Value
      SAPImportArray(iSAPCount, 2) = Cells(iRow, 6).Value
      SAPImportArray(iSAPCount, 3) = Cells(iRow, 8).Value
      SAPImportArray(iSAPCount, 4) = Cells(iRow, 9).Value
      SAPImportArray(iSAPCount, 5) = Cells(iRow, 11).Value
      SAPImportArray(iSAPCount, 6) = Cells(iRow, 15).Value
      SAPImportArray(iSAPCount, 7) = Cells(iRow, 3).Value
      SAPImportArray(iSAPCount, 8) = Cells(iRow, 4).Value
   
      strStartPos = Cells(iRow, 14).Value
      strCompDesc = ""
     
      Do
        strCompDesc = strCompDesc & Cells(iRow, 15).Value & Chr(10) & Chr(13)
        iRow = iRow + 1
      Loop While Cells(iRow, 14).Value = strStartPos
     
      SAPImportArray(iSAPCount, 9) = strCompDesc
      iSAPCount = iSAPCount + 1
      ReDim Preserve SAPImportArray(iSAPCount, 9) 'Her går det så galt!
    Next

Lavede det om sådan så jeg kun gemmer 1 linie ad gangen, og så indsætter jeg de data med det samme i stedet for at løbe hele tekstfilen igennem med det samme. Det giver godt nok en masse skift mellem de 2 filer, men det er der jo ikke så meget at gøre ved.

Lav et svar hvis du vil have lidt point ;)

her er jeg gået en lille omvej, det er nok ikke en måde du er vant til.


iMaxRow = ActiveSheet.UsedRange.Rows.Count
    iSAPCount = 1
    Dim SAPImport()
    Dim SAPImportArray(1, 9) 'Første gang, så ingen problemer!
    For iRow = 1 To iMaxRow
      SAPImportArray(iSAPCount, 1) = Cells(iRow, 5).Value
      SAPImportArray(iSAPCount, 2) = Cells(iRow, 6).Value
      SAPImportArray(iSAPCount, 3) = Cells(iRow, 8).Value
      SAPImportArray(iSAPCount, 4) = Cells(iRow, 9).Value
      SAPImportArray(iSAPCount, 5) = Cells(iRow, 11).Value
      SAPImportArray(iSAPCount, 6) = Cells(iRow, 15).Value
      SAPImportArray(iSAPCount, 7) = Cells(iRow, 3).Value
      SAPImportArray(iSAPCount, 8) = Cells(iRow, 4).Value
   
      strStartPos = Cells(iRow, 14).Value
      strCompDesc = ""
     
      Do
        strCompDesc = strCompDesc & Cells(iRow, 15).Value & Chr(10) & Chr(13)
        iRow = iRow + 1
      Loop While Cells(iRow, 14).Value = strStartPos
     
      SAPImportArray(iSAPCount, 9) = strCompDesc
    ReDim Preserve SAPImport(iSAPCount)
    SAPImport(iSAPCount) = SAPImportArray 'Her går det så galt!
      iSAPCount = iSAPCount + 1
     
    Next

Dine variabler ligger nu i  SAPImport(1)(1,1) og fremefter, den sidste i første linie er SAPImport(1)(1,9)

næste linie starter i SAPImport(2)(1,1) o. s. v.

en rettelse

iMaxRow = ActiveSheet.UsedRange.Rows.Count
    iSAPCount = 1
    Dim SAPImport()
    Dim SAPImportArray(1, 9)
    For iRow = 1 To iMaxRow
      SAPImportArray(1, 1) = Cells(iRow, 5).Value
      SAPImportArray(1, 2) = Cells(iRow, 6).Value
      SAPImportArray(1, 3) = Cells(iRow, 8).Value
      SAPImportArray(1, 4) = Cells(iRow, 9).Value
      SAPImportArray(1, 5) = Cells(iRow, 11).Value
      SAPImportArray(1, 6) = Cells(iRow, 15).Value
      SAPImportArray(1, 7) = Cells(iRow, 3).Value
      SAPImportArray(1, 8) = Cells(iRow, 4).Value
   
      strStartPos = Cells(iRow, 14).Value
      strCompDesc = ""
     
      Do
        strCompDesc = strCompDesc & Cells(iRow, 15).Value & Chr(10) & Chr(13)
        iRow = iRow + 1
      Loop While Cells(iRow, 14).Value = strStartPos
     
      SAPImportArray(1, 9) = strCompDesc
    ReDim Preserve SAPImport(iSAPCount)
    SAPImport(iSAPCount) = SAPImportArray ' smider arrayet SAPImportArray ind i SAPImport(iSAPCount)
      iSAPCount = iSAPCount + 1
     
    Next

OK. Det er også en mulighed ;)

Ved du hvordan jeg kan få fjernet det sidste linieskift (Chr(10) - Chr(13) kom med ved en fejl) i min strCompDesc streng? At fjerne det sidste tegn i strengen har ingen effekt, og kan jo ikke lave en replace på hele strengen eftersom det jo kun er det sidste linieskift jeg vil fjerne :)

en lidt nemmere

iMaxRow = ActiveSheet.UsedRange.Rows.Count
    iSAPCount = 1
    Dim SAPImport()
    Dim SAPImportArray(9)
    For iRow = 1 To iMaxRow
      SAPImportArray(1) = Cells(iRow, 5).Value
      SAPImportArray(2) = Cells(iRow, 6).Value
      SAPImportArray(3) = Cells(iRow, 8).Value
      SAPImportArray(4) = Cells(iRow, 9).Value
      SAPImportArray(5) = Cells(iRow, 11).Value
      SAPImportArray(6) = Cells(iRow, 15).Value
      SAPImportArray(7) = Cells(iRow, 3).Value
      SAPImportArray(8) = Cells(iRow, 4).Value
   
      strStartPos = Cells(iRow, 14).Value
      strCompDesc = ""
     
      Do
        strCompDesc = strCompDesc & Cells(iRow, 15).Value & Chr(10) & Chr(13)
        iRow = iRow + 1
      Loop While Cells(iRow, 14).Value = strStartPos
     
      SAPImportArray(9) = strCompDesc
    ReDim Preserve SAPImport(iSAPCount)
    SAPImport(iSAPCount) = SAPImportArray ' smider arrayet SAPImportArray ind i SAPImport(iSAPCount)
      iSAPCount = iSAPCount + 1
     
    Next

Dine variabler ligger nu i  SAPImport(1)(1) og fremefter, den sidste i første linie er SAPImport(1)(9)

næste linie starter i SAPImport(2)(1) o. s. v.

er det fra tekstfilen du får fejl, hvordan ser koden ud der. ?

Do
        strCompDesc = strCompDesc & Cells(iRow, 15).Value & Chr(10) & Chr(13)
        iRow = iRow + 1
      Loop While Cells(iRow, 14).Value = strStartPos
      strCompDesc = left(strCompDesc,len(strCompDesc)-2)

kan det ikke gøre det

Nej, det hjælper som sagt ikke noget at fjerne de sidste par tegn. Om jeg skriver minus 1, 2, eller 5 ændrer ikke på strengen.

så vidt jeg kan se, virker det her

iMaxRow = ActiveSheet.UsedRange.Rows.Count
    iSAPCount = 1
    Dim SAPImport()
    Dim SAPImportArray(9)
    For iRow = 1 To iMaxRow
      SAPImportArray(1) = Cells(iRow, 5).Value
      SAPImportArray(2) = Cells(iRow, 6).Value
      SAPImportArray(3) = Cells(iRow, 8).Value
      SAPImportArray(4) = Cells(iRow, 9).Value
      SAPImportArray(5) = Cells(iRow, 11).Value
      SAPImportArray(6) = Cells(iRow, 15).Value
      SAPImportArray(7) = Cells(iRow, 3).Value
      SAPImportArray(8) = Cells(iRow, 4).Value
   
      strStartPos = Cells(iRow, 14).Value
      strCompDesc = ""
     
      Do
        strCompDesc = strCompDesc & Cells(iRow, 15).Value & Chr(10) & Chr(13)
        iRow = iRow + 1
      Loop While Cells(iRow, 14).Value = strStartPos

      strCompDesc = Left(strCompDesc, Len(strCompDesc) - 2)' fjerner de 2 sidste
      SAPImportArray(9) = strCompDesc

    ReDim Preserve SAPImport(iSAPCount)
    SAPImport(iSAPCount) = SAPImportArray ' smider arrayet SAPImportArray ind i SAPImport(iSAPCount)
      iSAPCount = iSAPCount + 1
     
    Next

Det virkede ikke umiddelbart hos mig, så jeg lavede lidt om på det så det nu ser sådan her ud inde i min for/next:

      FirstRow = True
     
      Do
        If Not FirstRow Then strCompDesc = strCompDesc & Chr(10)

        FirstRow = False
        strtmp = Trim(Cells(iRow, 15).Value)
        If strtmp <> "" Then strCompDesc = strCompDesc & Trim(Cells(iRow, 15).Value)
        iRow = iRow + 1
      Loop While Cells(iRow, 14).Value = strStartPos

Det giver samme effekt.

Laver du et svar? :)

et svar ;-))