cellen optellen naast gevulde cellen in een bestand

[kesharo]

Beste forumleden,

Ik wil graag in een bestand, in verschillende kolommen, op verschillende tabbladen, cellen optellen die links naast een met tekst gevulde cel staan.

Bijv.
5 en in de vlg cel PiePuk
3 en in de vlg cel PiePuk

Dit staat door het hele bestand. op willekeurige plaatsen.
Dan wil ik graag op een voorblad 5 en 3 optellen. Of zoveel keer als hij vermeld staat. Ik hoop dat iemand mij kan helpen.

Kesharo

 

[wampier]

Kun je wat meer uitleg geven over de opbouw? Het kan waarschijnlijk met een macro, maar als alles netjes onder elkaar staat kan het mogelijk ook met een "som.als". Hoe willekeurig is "willekeurig" en hoeveel termen wil je optellen? of slechts 1?

 

[kesharo]

Ik heb een bestand bijgevoegd waarin denk ik duidelijk is hoe het er in staat. Dan zou op blad 1 een bepaalde afkorting getotaliseerd moeten worden uit blad 2 en 3(kan ook totaal 10 bladen zijn).

Dank je Kesharo

 

[wampier]

Het makkelijkste is om de lijst variabel te bouwen, maar het kan ook met de vaste lijst op het eerste blad. Let dan wel, als er een fout gemaakt wordt op het eerste blad werkt het allemaal niet meer. Hoewel bij dynamisch krijg je ook "AOV" in je lijst.

De blauwe kolommen zijn lastig. Is het zeker dat de vormgeving van de formulieren nooit veranderd? Om dit automatisch te laten verlopen moet er een logica zijn in de velden. opleiding "1" en "2" zijn namelijk niet hetzelfde (extra kolommen). Als er vanuit gegaan kan worden dat bijvoorbeeld er altijd 3 kolommen zijn is het al eenvoudiger.

 

[kesharo]

Het kan ook gerust altijd 3 kolommen zijn. Als dat gemakkelijker is dan is dat geen probleem. Wat betreft het voorblad. Ik dacht dat het handig zou zijn om de afkortingen er op te vermeldn. Het mag ook dat hij vermeld wordt als hij in het bestand voorkomt.

 

[wampier]

Type info
    wie As String
    uren As Double
End Type

Sub verzamel()
Dim lijst() As info
ReDim lijst(0)
    For Each vel In Sheets
        If Left(vel.Name, 9) = "opleiding" Then
            For Each rijloper In Range(vel.[a4], vel.[ii4].End(xlToLeft))
                If rijloper.Value = "docent" Then
                    For Each cell In Range(rijloper, rijloper.Offset(50000).End(xlUp))
                        If cell.Value <> "" Then
                            gevonden = False
                            waarde = Val(cell.Offset(0, -1))
                            For i = 0 To UBound(lijst)
                                If lijst(i).wie = cell.Value Then
                                    gevonden = True
                                    lijst(i).uren = lijst(i).uren + waarde
                                End If
                            Next i
                            If Not gevonden Then
                                lijst(UBound(lijst)).wie = cell.Value
                                lijst(UBound(lijst)).uren = waarde
                                ReDim Preserve lijst(UBound(lijst) + 1)
                            End If
                        End If
                    Next cell
                End If
            Next rijloper
        End If
    Next vel

With Sheets.Add
    For i = 0 To UBound(lijst) - 1
        .Cells(i + 1, 1) = lijst(i).wie
        .Cells(i + 1, 2) = lijst(i).uren
    Next i
End With

End Sub

Let op dit werkt niet direct op het voorbeeld, omdat op het tweede blad de hoofdlijnen op de verkeerde regel start. De bladen moeten redelijk uniform zijn voor de macro om de juiste data te herkennen. Dit kan nog wat aangepast worden om de output te verbeteren, maar volgens mij is dit ongeveer wat je zoekt.

EDIT De header regel moet op regel 4 staan. Dat is in je voorbeeld goed op blad 1 maar niet op blad 2