Tabelvuller vanuit sheets

[Symphysodon]

Eerdere post: sheetvuller vanuit tabel, maar nu andersom
Zoiets:

Sub M_snb()
  ar = Sheets("Const").ListObjects(1).DataBodyRange
  ReDim sn(UBound(ar, 2) * 34, 0)
    
  For j = 1 To UBound(ar)
      If Left(ar(j, 1), 1) = "V" Then
          For jj = 0 To UBound(ar, 2) - 3
            sn(34 * jj, 0) = ar(j, jj + 3)
          Next
       
         Sheets(ar(j, 1)).Cells(30, 31).Resize(UBound(sn)) = sn
      End If
    Next
End Sub

Situatie:
Op elke sheet beginnend met een V staan 12 tabellen. In elk van die twaalf tabellen staan een aantal parameters( m1g, s1g) die per sheet verzameld moeten worden in een resultatentabel op sheet("Rapportage") beginnend op startrij sR=8
met output:
sR=8 met t=20
m1g=cells(SR,2)
s1g=cells(SR,3)
..

Input sheet "V.."
R=19
K=17
teller= 34

m1g=cells(R,K)
s1g=cells(R+1,K)
...

Kan dit ook op zo'n elegante manier als de oplossing van snb en VenA bij mijn vorige post, ofmoet ik met tellers en lussen aan de slag?

Alvast bedankt weer.

Mvg
Marco

 

[Symphysodon]

Eerste opzet:

Sub tabelvuller()

For i = 1 To 12
ar = Sheets("Rapportage").ListObjects(i).DataBodyRange
  ReDim sn(UBound(ar, 2) * 20, 0)
    
  For j = 1 To UBound(ar)
      If Left(ar(j, 1), 1) = "V" Then
          For jj = 0 To UBound(ar, 2) - 3
            sn(20 * jj, 3) = ar(j, jj + 19)
          Next
       
         Sheets(ar(j, 1)).Cells(8, 3).Resize(UBound(sn)) = sn
      End If
    Next
Next
End Sub

Het loopen van een Listobject heb ik nog niet door en ik weet ook niet zeker of het met de rijen en kolommen goed gaat

 

[Symphysodon]

Ik denk niet dat dit goed is. In het voorbeeld zou je 12x4 (sheets)= 48 variabele listobjecten hebben.

 

[Symphysodon]

Helaas gaat het me op deze manier niet lukken. Dan maar met wat lusjes.

Sub dataverwerking()
Dim ws As Variant
Application.ScreenUpdating = False

For Each ws In Worksheets
  With Sheets(ws.Name)
    s = Left(ws.Name, 1)
    If s = "V" Then
        sR = 8
        r = 19
        For i = 1 To 12
             xg1 = .Cells(r, 17)
             xs1 = .Cells(r + 1, 17)
             xg2 = .Cells(r, 18)
             xs2 = .Cells(r + 1, 18)
             xgd = .Cells(r, 21)
             xsd = .Cells(r + 1, 21)
             xRabs = .Cells(r + 9, 21)
             xRrel = .Cells(r + 10, 21)
            
             For Each cell In Sheets("Rapportage").Range(Cells(sR, 2), Cells(sR + 14, 2))
                If ws.Name = cell Then
                    s = cell.Row
                    sR = s
                    Sheets("Rapportage").Cells(sR, 3).Value = xg1
                    Sheets("Rapportage").Cells(sR, 4).Value = xs1
                    Sheets("Rapportage").Cells(sR, 5).Value = xg2
                    Sheets("Rapportage").Cells(sR, 6).Value = xs2
                    Sheets("Rapportage").Cells(sR, 7).Value = xgd
                    Sheets("Rapportage").Cells(sR, 8).Value = xsd
                    Sheets("Rapportage").Cells(sR, 9).Value = xRabs
                    Sheets("Rapportage").Cells(sR, 10).Value = xRrel
                End If
             Next
             r = r + 34
             sR = sR + 20
        Next

    End If
  End With
Next

Application.ScreenUpdating = True
End Sub

 

[snb]

Doe nog eens goed je best :

- een duidelijk voorbeeldbestand te maken
- een relatie te leggen tussen het resultaatwerkblad en de overige werkbladen
- te specificeren wat je met een tabel bedoelt (listobject, range, of iets anders); we werken tenslotte in Excel
- je vraag nog eens precieser te formuleren vanuit het perspektief van de lezer.

 

[Symphysodon]

Bij deze:
Het voorbeeldbestand aangepast aan de gegeven code in #4. De code is misschien simpel en niet heel efficiënt, maar het werkt wel.

Het is de bedoeling dat van elke tabel op een sheet beginnend met een V een bepaalde parameter (aangegeven met geel) wordt gekopieerd naar verzameltabellen op de sheet: Rapportage.
Er hoeven geen parameters met elkaar vergeleken te worden, want alle tabellen staan op chronologische volgorde.

Het lukt me niet met de tabel als listobject omdat ik het niet variabel krijg. Of ik moet 12 listobjecten aanmaken (in het voorbeeld zijn het er 3).

 

[snb]

Hoe krijg je het voor elkaar zulke onvolledige gegevens te presenteren.

 

[Symphysodon]

Geen idee. Ik dacht volledig te zijn. Het werkende programma staat in de module tabelvuller. Soms zegt code meer dan 1000 woorden.

Als je de code start worden de tabellen op de sheet Rapportage netjes gevuld met de getallen (geel gekleurd) uit de sheets beginnend met een V.