Eén array uit meerdere tabbladen

Excelbat · 10 nov 2015

Goedenavond allen,

Zie ook dit draadje: KlikKlak

Ik probeer een VBAtje van HSV om te vormen van het zoeken in één tabblad naar het zoeken in meerdere tabbladen.

Code:

Sub hsv()
For i is 1 to 3
With Sheets(i)
    sn = .Cells(1).CurrentRegion
    [COLOR="#FF0000"]ReDim arr(UBound(sn) * Application.Max(.columns(1)), 0)[/COLOR]
    For j = 2 To UBound(sn)
        For jj = 1 To sn(j, 1)
            arr(n, 0) = sn(j, 2)
            n = n + 1
        Next jj
    Next j
End With
Next i
 Sheets(1).[d1].Resize(n) = arr
End Sub

'

Ik vermoed dat ik ook iets moet wijzigen in de rode regel. Wie kan mij helpen?

Bekijk bijlage EénArrayUitMeerdereTabbladen.xlsb

Greetz/Excelbat

VenA · 10 nov 2015

Wat heeft het draadje 'klikklak' er mee te maken en wat is de concrete vraag? Als ik op de knop klik dan krijg ik het gewenste resultaat.

Edit

Of probeer je een array te maken met de som van de van de mogelijkheden uit de eerste kolom van de verschillende tabjes?

Dan krijg je zoiets:

Code:

Sub VenA()
For Each sh In Sheets
    t = t + Application.Sum(sh.Columns(1).SpecialCells(2, 1))
Next sh
ReDim ar(1 To t)
End Sub

HSV · 10 nov 2015

Code:

Sub HsvExcelbat()
Dim arr(), sn, i As Long, a As Long, b As Long, j As Long, jj As Long, n As Long
For i = 1 To 3
With Sheets(i)
    a = Application.Max(.Columns(1))
     If b < a Then b = a
      sn = .Cells(1).CurrentRegion
        ReDim Preserve arr(UBound(sn) * b)
          For j = 2 To UBound(sn)
            For jj = 1 To sn(j, 1)
                arr(n) = sn(j, 2)
                n = n + 1
             Next jj
          Next j
  End With
Next i
Sheets(1).[d1].Resize(n) = Application.Transpose(arr)
End Sub

Excelbat · 11 nov 2015

@VenA: N.a.v. uw verzoek in het draadje 'KlikKlak' om een nieuw Topic te maken, heb ik dit draadje gemaakt. En sorry, ik kwam er achter dat ik verkeerde url hierin geplakt heb. Is nu gecorrigeerd. Zoals in dat andere draadje gezegd, ik heb veel belangstelling voor arrays, en ik wilde een array maken met gegevens uit verschillende tabbladen. Met een combinatie van #2 en #3 is dit gelukt. Zowel naar VenA als HSV mijn hartelijke dank. Ik vind het erg leerzaam om dit soort dingen uit te pluizen.

HSV had hier een foutmelding. Dimensie van de array was te klein.

Code:

ReDim Preserve arr(UBound(sn) * b)

Code is dus geworden:

Code:

Sub HsvCombVenA()
Dim arr(), sn, i As Long, a As Long, b As Long, j As Long, jj As Long, n As Long

For Each sh In Sheets
    t = t + Application.Sum(sh.Columns(1).SpecialCells(2, 1))
Next sh
ReDim ar(1 To t)
MsgBox ("Array wordt uitgebreid tot waarde van T is: " & t)

For i = 1 To 3
With Sheets(i)
    Sheets(i).Activate
    a = Application.Max(.Columns(1))
'MsgBox ("De maximale waarde van (hoeveel keren kopiëren) A is: " & a)
'     If b < a Then b = a 'Heeft te maken met de dimensie van de array
'MsgBox ("De waarde van B is: " & b)
'Hier wordt de range van sn bepaald:
'Sheets(i).Cells(1).CurrentRegion.Select
      sn = .Cells(1).CurrentRegion
        ReDim Preserve arr(UBound(sn) * t) 'b vervangen door t, en dan loopt 'ie goed door
'We kijken vanaf rij 2:
'MsgBox ("De waarde van UBound(sn) is: " & UBound(sn))
          
          For j = 2 To UBound(sn)
'Het aantal kopiëren uit kolom A (waarde van JJ):
'MsgBox ("De waarde van J (rij) is: " & j & ", en de waarde van JJ is: " & jj)
            For jj = 1 To sn(j, 1)
                arr(n) = sn(j, 2)
                n = n + 1
             Next jj
          Next j
  End With
Next i
Sheets(1).Activate
Sheets(1).[d1].Resize(n) = Application.Transpose(arr)
End Sub

Greetz/Excelbat

HSV · 11 nov 2015

Hallo Excelbat,

Ik weet toch nog een fout te creëren in onderstaande bestand met de geworden code van je.
Ik heb er een twee-dimensionele array van gemaakt waarbij ik eerst de grootte van de array vaststel (transpose kan het aantal niet aan van de 1-dimensionele array).

snb · 12 nov 2015

Suggestie:

Code:

Sub M_snb()
   ReDim sn([sum(Blad1:Blad3!A:A)], 0)
   
   For Each sh In Sheets
      sp = sh.Cells(1).CurrentRegion
      
      For j = 2 To UBound(sp)
        For jj = 1 To sp(j, 1)
          sn(n, 0) = sp(j, 2)
          n = n + 1
        Next
      Next
   Next

   Blad1.Cells(1, 4).Resize(n) = sn
End Sub

of

Code:

Sub M_snb()
   For Each sh In Sheets
      sn = sh.Cells(1).CurrentRegion
      
      For j = 2 To UBound(sn)
        c00 = c00 & Replace(String(sn(j, 1), "|"), "|", "|" & sn(j, 2))
      Next
   Next

   sn = Split(c00, "|")
   Blad1.Cells(1, 4).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

Excelbat · 12 nov 2015

Thanx HSV en SNB,

Dank voor jullie inzet. Geweldig leuk en leerzaam om deze code's te ontleden. Heb nog wel een vraagje aan SNB bij de tweede code.
De uitkomst wordt in D2 neergezet i.p.v. in D1, en ik begrijp niet waarom.

Code:

Blad1.Cells(1, 4).Resize(UBound(sn) + 1) = Application.Transpose(sn)

Code:

Sub HsvExcelbatOntleed()
Dim arr(), sn, i As Long, a As Long, b As Long, j As Long, jj As Long, n As Long, t As Long, x As Long

For i = 1 To 3                                  'Hier begint de eerste loop
   a = Application.Max(Sheets(i).Columns(1))    'Maximum waarde in Kolom A = 30000
   b = b + a                                    'Waarde B wordt dus 30000 + 1 + 3000
   sn = Sheets(i).Cells(1).CurrentRegion        'Worksheet range uitkiezen
        x = UBound(sn)                          'Waarde X in dit geval 5, want 5 rijen
        t = t + x                               'Waarde T wordt dus 5 + 2 + 3
 Next i                                         'Hier gaan we in een loop naar de volgende sheet
     
     ReDim arr(t * b, 0)                        'Dimensie wordt dus 10 * 33001

For i = 1 To 3                                  'Hier begint de tweede loop
With Sheets(i)                                  'We beginnen in de eerste sheet
    sn = .Cells(1).CurrentRegion                'Worksheet range uitkiezen
          For j = 2 To UBound(sn)               'We werken vanaf rij 2 t/m (in dit geval) rij 5
            For jj = 1 To sn(j, 1)              'De waarde uit kolom 1 die bepaalt hoeveel kopiën er gemaakt worden
                arr(n, 0) = sn(j, 2)            'Hier wordt de array gevuld met waarde uit kolom B
                n = n + 1                       'Hier wordt N opgehoogd om naar de volgende rij in de array te gaan
             Next jj                            'Dus 30000 keer een loop
          Next j                                'Rij 2 t/m 5, volgende rij dus
  End With                                      'Einde loop eerste sheet
Next i                                          'We gaan naar de volgende sheet

Sheets(1).[d1].Resize(n) = arr                  'Uitkomst in kolom D

End Sub

Code:

Sub M_snbEenOntleed()
   ReDim sn([sum(Blad1:Blad3!A:A)], 0)  'Hier wordt alles bij elkaar opgeteld uit Kolom A 33005.
   For Each sh In Sheets                'Hier begint de loop om door alle sheets te wandelen.
      sp = sh.Cells(1).CurrentRegion    'SP wordt in Blad1 range (A1:B5)
      
      For j = 2 To UBound(sp)           'We beginnen in rij 2 en gaan door t/m rij 5
        For jj = 1 To sp(j, 1)          'De waarde uit kolom 1 die bepaalt hoeveel kopiën er gemaakt worden
          sn(n, 0) = sp(j, 2)           'Hier wordt de array gevuld met waarde uit kolom B
          n = n + 1                     'Hier wordt N opgehoogd om naar de volgende rij in de array te gaan
        Next jj                         'Dus 30000 keer een loop
      Next j                            'Rij 2 t/m 5, volgende rij dus
   Next sh                              'We gaan naar de volgende sheet

   Blad1.Cells(1, 4).Resize(n) = sn     'Uitkomst in kolom D
End Sub

Code:

Sub M_snbTweeOntleed()
   For Each sh In Sheets                                                'Hier begint de loop om door alle sheets te wandelen.
      sn = sh.Cells(1).CurrentRegion                                    'SN wordt in Blad1 range (A1:B5)
      
      For j = 2 To UBound(sn)                                           'We beginnen in rij 2 en gaan door t/m rij 5
        c00 = c00 & Replace(String(sn(j, 1), "|"), "|", "|" & sn(j, 2)) 'sn(j, 1)=hoeveel keer kopiëren, sn(j, 2)=wat er gekopieerd moet worden.
        Excelbat01 = String(15, "d")                                    'Waarde d wordt 15x achter elkaar gekopieerd
        'MsgBox Excelbat01
        Excelbat02 = Replace("aaadddbbddkkbf", "d", "k")                'Vervang alle d door een k
        'MsgBox Excelbat02
      Next j                                                            'Rij 2 t/m 5, volgende rij dus
   Next sh                                                              'We gaan naar de volgende sheet

   sn = Split(c00, "|")                                                 'Hier gaan de sn weer splitsen in losse waarden
   Blad1.Cells(1, 4).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

Greetz/Excelbat

snb · 12 nov 2015

Met welk teken begint de tekenreeks die in een array gesplitst wordt ?

Excelbat · 12 nov 2015

Goedemiddag SNB,

De array begint met een piping ("|"). Dat zou betekenen dat ik dus het allereerste teken van c00 eruit zou moeten slopen met bijv. MID (cOO,2,35000)?
Ben ik dan op de goede weg? Of is er een elegantere oplossing?

Greetz/Excelbat

Excelbat · 12 nov 2015

Mijn verhaaltje van hierboven uitgetest, en het werkt:

Code:

c00 = Mid(c00, 2)
   sn = Split(c00, "|")                                                 'Hier gaan de sn weer splitsen in losse waarden
   Blad1.Cells(1, 4).Resize(UBound(sn) + 1) = Application.Transpose(sn)

Greetz/Excelbat

snb · 12 nov 2015

En zoals je vaak in mijn code kunt zien:

Code:

   sn = Split(mid(c00,2), "|")                                                 'Hier gaan de sn weer splitsen in losse waarden
   Blad1.Cells(1, 4).Resize(UBound(sn) + 1) = Application.Transpose(sn)

Excelbat · 12 nov 2015

Ja, dat is inderdaad de mogelijkheid zonder mijn extra tussenstap. Mijn hartelijk dank voor uw reactie.

Greetz/Excelbat

snb · 12 nov 2015

Had je hier al gekeken ?

http://www.snb-vba.eu/VBA_Arrays.html

Excelbat · 12 nov 2015

Ja, had ik inderdaad al gekeken, maar gaat me nog een stapje te hoog. Ik werk liever vanuit praktijkvoorbeelden, zodat ik kan zien en terugrekenen wat er gebeurt.
Misschien een idee voor u om wat sheetjes op uw site te plaatsen met wat werkende voorbeelden?

Greetz/Excelbat

Eén array uit meerdere tabbladen

Excelbat

Gebruiker

VenA

Inventaris

HSV

Inventaris

Excelbat

Gebruiker

HSV

Inventaris

Bijlagen

snb

Verenigingslid

Excelbat

Gebruiker

snb

Verenigingslid

Excelbat

Gebruiker

Excelbat

Gebruiker

snb

Verenigingslid

Excelbat

Gebruiker

snb

Verenigingslid

Excelbat

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy