16. januar 2014 - 13:20Der er
9 kommentarer og 1 løsning
Brug af Arrays med flere dimensioner og betingelser
Jeg vil gerne lære noget mere om Arrays, herunder at behandle Arrays for at sætte resultatet ind i en ny Array.
Jeg kan jo se, at det går meget hurtigere, når man henter data fra tabeller via Arrays.
Jeg har lavet følgende lille sub, hvor jeg ikke kender antallet af rækker i den endelige array på forhånd - samt at der er en betingelse om at én kolonne skal indholde en bestemt værdi - før at informationer fra rækken kan tages med i arrayet.
Den fungerer sådan set fint. Men jeg er sikker på at nogen af jer, kunne gøre koden mere sikker og smart - evt. at behandle betingelsen (i den ene kolonne) smartere end jeg har gjort.
Håber på gode input. På forhånd tak.
Her følger min kode:
Sub ArrayTest()
Dim c As Variant Dim TestArray(1 To 999, 1 To 12) As Variant Dim CountR, CountRowA As Integer Dim TilOmr As Range
'Rensning og definering af til-område Set TilOmr = Sheets("Overblik").Range(Range("A2"), Sheets("Overblik").Range("A2").End(xlDown).Offset(0, 11)) TilOmr.ClearContents
'Data Til Array CountR = 0 For Each c In Range(Sheets("Data").Range("A3"), Sheets("Data").Range("A9999").End(xlUp)).Cells If c.Offset(0, 6).Value = "NO" Then TestArray(CountR + 1, 1) = c TestArray(CountR + 1, 2) = c.Offset(0, 1) TestArray(CountR + 1, 3) = c.Offset(0, 2) TestArray(CountR + 1, 4) = c.Offset(0, 3) TestArray(CountR + 1, 5) = c.Offset(0, 4) TestArray(CountR + 1, 6) = c.Offset(0, 5) TestArray(CountR + 1, 7) = c.Offset(0, 10) TestArray(CountR + 1, 8) = c.Offset(0, 11) TestArray(CountR + 1, 9) = c.Offset(0, 27) TestArray(CountR + 1, 10) = c.Offset(0, 28) TestArray(CountR + 1, 11) = c.Offset(0, 30) TestArray(CountR + 1, 12) = c.Offset(0, 32) CountR = CountR + 1 Else End If Next c
'Tilpas Tilomr - samt indsæt array Set TilOmr = Range("A2").Resize(CountR, 12) TilOmr.Value = TestArray
Option Base 1 ' gør at alle variabler starter med 1 og ikke 0
Public Sub ArrayTest() 'Data Til Array Dim AlleData As Variant, CountR As Long, X As Long, I As Long, A As Integer Dim TestArray() As Variant, Col As Variant Dim TilOmr As Range
'Rensning og definering af til-område Set TilOmr = Sheets("Overblik").Range(Range("A2"), Sheets("Overblik").Range("A2").End(xlDown).Offset(0, 11)) TilOmr.ClearContents Set TilOmr = Nothing
For I = 1 To UBound(AlleData) If AlleData(I, 7) = "NO" Then CountR = CountR + 1 ' hvor mange med "NO" Next
X = 0 ReDim TestArray(CountR, 11) ' Dimmer uddata
For I = 1 To UBound(AlleData) If AlleData(I, 7) = "NO" Then X = X + 1 For A = 1 To 11 TestArray(X, A) = AlleData(I, Col(A)) ' putter data i uddata Next End If Next
'Tilpas Tilomr - samt indsæt array Set TilOmr = Sheets("Overblik").Range("A2").Resize(CountR, 12) TilOmr.Value = TestArray Set TilOmr = Nothing
Det hjalp at ændre TilOmr til: Set TilOmr = Sheets("Overblik").Range("A2").CurrentRegion
Men selvom jeg ændre 32 til 33 hjælper det ikke.
Dernæst kan jeg ikke helt forstå: .Cells i udtrykket. Altså: AlleData = Range(Sheets("Data").Range("A3"), Sheets("Data").Cells(Sheets("Data").Range("A9999").End(xlUp).Row, 33))
Dernæst flyttede jeg koden X = X+1 Så lander informationerne korrekt
Men stadig nysgerrig mht til Cells i AllData
Public Sub ArrayTestBak() 'Data Til Array Dim AlleData As Variant, CountR As Long, X As Long, I As Long, A As Integer Dim TestArray() As Variant, Col As Variant Dim TilOmr As Range
'Rensning og definering af til-område If Sheets("Overblik").Range("A2") <> "" Then Range(Sheets("Overblik").Range("A2"), Sheets("Overblik").Range("A2").End(xlDown).Offset(0, 11)).ClearContents Else End If Set TilOmr = Nothing
For I = 1 To UBound(AlleData) If AlleData(I, 7) = "NO" Then CountR = CountR + 1 ' hvor mange med "NO" Next
X = 0 ReDim TestArray(CountR, 11) ' Dimmer uddata
For I = 1 To UBound(AlleData) If AlleData(I, 7) = "NO" Then 'X = X + 1 For A = 1 To 11 TestArray(X, A) = AlleData(I, Col(A)) ' putter data i uddata Next X = X + 1 End If Next
'Tilpas Tilomr - samt indsæt array Set TilOmr = Sheets("Overblik").Range("A2").Resize(CountR, 12) TilOmr.Value = TestArray Set TilOmr = Nothing
Sheets("Data").Cells(Sheets("Data").Range("A9999").End(xlUp).Row, 33)) er det samme som Range("AG" & sidste udfyldte række) Det er bare fordi det er nemmere med tal end bogstaver i dette sammenhæng
Jeg er blevet meget klogere - på dette område. Hvorvidt det hænger fast er så næste issue.
Læg et svar.
Jeg glemte den øverste linie i første omgang. Men efter den kom med - samt de øvrige rettelser - så virker det. Det væsentlige er så om jeg kan huske det til næste gang ;-))))
Ang. hastighed - så har jeg ikke fået testet på store datamængder endnu. Men der er mærkbar forskel i forhold til den øverst nævnte kode.
Men det at overgå til arrays - er jo helt vildt - i forhold til den metode jeg brugte tidligere. Så det er vejen frem. Det belaster brugernes maskiner meget mindre
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.