Avatar billede hjald8 Nybegynder
16. januar 2014 - 13:20 Der 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
   
End Sub
Avatar billede kabbak Professor
16. januar 2014 - 15:43 #1
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

CountR = 0
AlleData = Range(Sheets("Data").Range("A3"), Sheets("Data").Cells(Sheets("Data").Range("A9999").End(xlUp).Row, 32))
Col = Array(1, 2, 3, 4, 5, 6, 11, 12, 28, 29, 31, 33) ' dine kolonner

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

End Sub
Avatar billede hjald8 Nybegynder
16. januar 2014 - 18:34 #2
Hi Kabbak,

Det er jo en fantastisk kode i forhold til hvad jeg kunne finde på.

Kan godt lide ideen med at definere Col, tillige skal jeg da lære at bruge Lbound/Ubound. Men generelt en bedre måde at tænke i løsning på.

Koden understøtter jo reelt også hvis der var flere faste kriterier i forskellige kolonner, som der skulle tages hensyn til.

Jeg får dog en fejl (Runtime error 9. Subscript out of range.
Først fik jeg den oppe under linien i første afsnit: Set TilOmr = ....

Dernæst fik jeg samme fejl i 4 afsnit for linien: TestArray(X, A) = AlleData(I, Col(A)) ' putter data i uddata
Avatar billede kabbak Professor
16. januar 2014 - 18:55 #3
den første fejl får du hvis området
"Set TilOmr = Sheets("Overblik").Range(Range("A2"), Sheets("Overblik").Range("A2").End(xlDown).Offset(0, 11))"

er tomt.

den anden er nok fordi
AlleData = Range(Sheets("Data").Range("A3"), Sheets("Data").Cells(Sheets("Data").Range("A9999").End(xlUp).Row, 32))

skal være

AlleData = Range(Sheets("Data").Range("A3"), Sheets("Data").Cells(Sheets("Data").Range("A9999").End(xlUp).Row, 33))
Avatar billede hjald8 Nybegynder
16. januar 2014 - 19:12 #4
Tak for svar.

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))
Avatar billede hjald8 Nybegynder
16. januar 2014 - 19:27 #5
Hi fandt ud af det.

Jeg rettede endnu engang omkring TilOmr

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
   
    CountR = 0
    AlleData = Range(Sheets("Data").Range("A3"), Sheets("Data").Cells(Sheets("Data").Range("A9999").End(xlUp).Row, 33))
    Col = Array(1, 2, 3, 4, 5, 6, 11, 12, 28, 29, 31, 33) ' Definering af end-user kolonner
   
    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

End Sub
Avatar billede kabbak Professor
16. januar 2014 - 23:17 #6
du glemte vist den øverste linje, den skal være aller øverst i modulet

Option Base 1 ' gør at alle variabler starter med 1 og ikke 0

det er måske derfor at du får fejl
Avatar billede kabbak Professor
16. januar 2014 - 23:25 #7
AlleData = Range(Sheets("Data").Range("A3"), Sheets("Data").Cells(Sheets("Data").Range("A9999").End(xlUp).Row, 33))

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

den kan også skrives sådan her

Sheets("Data").Range("AG" & Sheets("Data").Range("A9999").End(xlUp).Row)
Avatar billede hjald8 Nybegynder
16. januar 2014 - 23:29 #8
Tusind tak for hjælpen.

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 ;-))))
Avatar billede kabbak Professor
16. januar 2014 - 23:41 #9
Godt, så får du et svar.

Hvordan er hastigheden i forhold til den gamle kode
Avatar billede hjald8 Nybegynder
16. januar 2014 - 23:47 #10
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
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester