gelijken bij elkaar optellen

[ewh]

we hebben een weeklijst waar bestemmingen opstaan waar de uren op verantwoordt worden.
per dag komt het zo maar voor dat er gelijke bestemmingen zijn
om nu het overzicht goed te behouden willen we graag dat de uren van een betreffende bestemming bij elkaar geteld worden

liefst met VBA
wie kan helpen? Bekijk bijlage voorbeeldbestand samenvoegen.xls
een voorbeeld bestandje is bij gevoegd

 

[edmoor]

Deze in I3 en dan naar beneden trekken:
=SOM.ALS(A:A;H3;B:B)

NB.
In A15 staat "oude " en in H9 staat "oude".
Die zijn dus niet aan elkaar gelijk.

 

[VenA]

Waarom het liefst met VBA? Heb je hier enige kennis van?

Ook in Xl-2003 kan je prima een draaitabel gebruiken.

 

[ewh]

alleen als een bestemming maar een keer voorkomt dan geeft hij 0 aan

kijk maar eens bij de bestemming "oude"

in de formule ga je er van uit dat de bestemmingen bekend zijn , maar dat is helaas niet zo
is er ook een formule die de dubbele bestemmingen er uit haalt?

 

[ewh]

Edmoor, je hebt helemaal gelijk ( maar dat wist je natuurlijk al ) ik had het niet gezien

Ven A een draaitabel , prima maar als je de sheet in een andere versie gebruikt dan is de draaitabel niet gelijk , ( door schade en schande wijs geworden )

 

[edmoor]

Ok, stukje VBA dan.
Test deze eens:

Public Sub Test()
    Dim Bestemming As String
    Dim a As Long
    Dim k As Long
    Dim x As Long
    
    k = 3
    With ActiveSheet
        For a = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
            .Cells(k, 12) = vbNullString
            If InStr(1, Bestemming, .Cells(a, 1), vbBinaryCompare) = 0 Then
                Bestemming = Bestemming & .Cells(a, 1) & "#"
                .Cells(k, 11) = .Cells(a, 1)
                For x = a To .Cells(.Rows.Count, "A").End(xlUp).Row
                    If .Cells(x, 1) = .Cells(k, 11) Then .Cells(k, 12) = .Cells(k, 12) + .Cells(x, 2)
                Next x
                k = k + 1
            End If
        Next a
    End With
End Sub

 

[ewh]

EDMOOR,
geweldig

hier was ik echt niet opgekomen.

bedankt voor je hulp

 

[ewh]

Ok, stukje VBA dan.
Test deze eens:

Public Sub Test()
    Dim Bestemming As String
    Dim a As Long
    Dim k As Long
    Dim x As Long
    
    k = 3
    With ActiveSheet
        For a = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
            .Cells(k, 12) = vbNullString
            If InStr(1, Bestemming, .Cells(a, 1), vbBinaryCompare) = 0 Then
                Bestemming = Bestemming & .Cells(a, 1) & "#"
                .Cells(k, 11) = .Cells(a, 1)
                For x = a To .Cells(.Rows.Count, "A").End(xlUp).Row
                    If .Cells(x, 1) = .Cells(k, 11) Then .Cells(k, 12) = .Cells(k, 12) + .Cells(x, 2)
                Next x
                k = k + 1
            End If
        Next a
    End With
End Sub

De code werkt prima, ik kan hem alleen niet echt begrijpen ( kan ej wat uitleg geven )
ik wil heel graag de waarde van CEL C3 gevolgd door een spatie , een streepje en weer een spatie voor de unieke waarde zetten.
maar je begrijpt het al ik weet niet waar ik dat moet toevoegen

 

[HSV]

Andere benadering.

Sub hsv()
Dim sn, i As Long, Odic As Object
sn = Sheets("blad1").Cells(2, 1).CurrentRegion
Set Odic = CreateObject("scripting.dictionary")
  For i = 1 To UBound(sn)
       Odic.Item(sn(i, 1)) = Odic.Item(sn(i, 1)) + sn(i, 2)
   Next i
Sheets("Blad1").Cells(2, 11).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
End Sub

 

[ewh]

Andere benadering.

Sub hsv()
Dim sn, i As Long, Odic As Object
sn = Sheets("blad1").Cells(2, 1).CurrentRegion
Set Odic = CreateObject("scripting.dictionary")
  For i = 1 To UBound(sn)
       Odic.Item(sn(i, 1)) = Odic.Item(sn(i, 1)) + sn(i, 2)
   Next i
Sheets("Blad1").Cells(2, 11).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
End Sub

deze code werkt niet bij mij ( excel 2003 )

 

[ewh]

een voorbeeld bestandje , wellicht dat , dat wat beter is Bekijk bijlage voorbeeldbestand samenvoegen.xls


ik hoop dat jullie een oplossing weten

 

[HSV]

Werkt uitstekend in je .xls.

 

[ewh]

Werkt uitstekend in je .xls.

je hebt gelijk, werkt goed hij begint alleen twee regels te hoog

wil je ook svp kijken naar mijn voorbeeld bestandje ,met de vraag stelling

 

[HSV]

De uitkomsten van je bestanden wisselen nogal.

 

[ewh]

De uitkomsten van je bestanden wisselen nogal.

het bestandje "voorbeeldbestandje samenvoegen " wat drie items hier boven staat is de juiste
in de afgelopen tijd er veel en laat een en ander geprobeerd zonder resultaat, waardoor er geen duidelijk heden ontstaan , sorry

 

[HSV]

Zet in elke regel de weeknummer.

Sub hsv()
Dim sn, i As Long, Odic As Object
sn = Sheets("blad1").Cells(2, 1).CurrentRegion
Set Odic = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
       Odic.Item(sn(i, 3) & " - " & sn(i, 1)) = Odic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
   Next i
Sheets("Blad1").Cells(3, 16).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
End Sub

 

[ewh]

Zet in elke regel de weeknummer.

Sub hsv()
Dim sn, i As Long, Odic As Object
sn = Sheets("blad1").Cells(2, 1).CurrentRegion
Set Odic = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
       Odic.Item(sn(i, 3) & " - " & sn(i, 1)) = Odic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
   Next i
Sheets("Blad1").Cells(3, 16).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
End Sub

TOP , ik ben er erg blij mee , nu kan ik weer verder.

bedankt