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
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
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.