• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

gegevens samenvoegen en rijen verwijderen

Status
Niet open voor verdere reacties.
A

arjancuijpers

Gebruiker
Lid geworden
30 nov 2015
Berichten
30
Beste,

Ik heb een bestand met gegevens.
nu staan er een aantal regels het zelfde type en deze moeten samengevoegd worden.
Ik Rij B staat welke ruimte nr het is.
In Rij E staat welke type group het is.
In Rij F staat welke type plaat het is.
In rij G staat de oppervlakte er van.

Als de eerst drie criteria Rij B, E en F het zelfde zijn dan moet Rij G opgeteld worden en de zelfde rij samengevoegd worden tot een rij.
Het liefste wil ik het voor elkaar krijgen met een macro zonder extra rijen toe te moeten voegen.
Heb al verschillende macro's op het internet omgebouwd maar blijft maar fout gaan.

Bij voorbaat dank.

mvg arjan

Bekijk bijlage My ITO Definition 3.xlsx
 
arjancuijpers zei:
Beste,
Als de eerst drie criteria Rij B, E en F het zelfde zijn dan moet Rij G opgeteld worden en de zelfde rij samengevoegd worden tot een rij.
Klik om te vergroten...

Kun je dat wat toelichten? wil je duplicaten opgeteld hebben en het nieuwe totaal in kolom "G"? oude rijen verwijderen?

is de lijst altijd netjes gesorteerd zoals nu? (duplicaten staan dus altijd onder elkaar?)
 
wampier zei:
Kun je dat wat toelichten? wil je duplicaten opgeteld hebben en het nieuwe totaal in kolom "G"? oude rijen verwijderen?

is de lijst altijd netjes gesorteerd zoals nu? (duplicaten staan dus altijd onder elkaar?)
Klik om te vergroten...

Beste wampier,

Het bestand is altijd opgebouw zoals het voorbeeld.
wil dus de duplicaten samen voegen als het waren. dus nog maar 1 rij maar dan met de opgetelde gegevens.
 
Zoiets?

Code: 
Sub dedup()
    Application.ScreenUpdating = False
    Dim eerste As Range
    verg = ""
    huid = ""
    comb = "@^#"
    Set eerste = [a1]
    For Each regel In Range([b2], [b65000].End(xlUp))
        If regel.Offset(0, 1).Value <> "" Then
            verg = ""
            huid = ""
            Set eerste = [a1]
        Else
            huid = regel + comb + regel.Offset(0, 3) + comb + regel.Offset(0, 4)
            If huid = verg Then
                If eerste = [a1] Then
                    Set eerste = regel.Offset(-1, 5)
                End If
                eerste.Value = eerste.Value + regel.Offset(0, 5)
                regel.Offset(0, -1) = "#$VERW$#"
            Else
                verg = huid
                Set eerste = [a1]
            End If
        End If
    Next regel
    Do
        gevonden = False
        For Each regel In Range([b2], [b65000].End(xlUp))
            If regel.Offset(0, -1) = "#$VERW$#" Then
                regel.EntireRow.Delete
                gevonden = True
            End If
        Next regel
    Loop Until gevonden = False
    Application.ScreenUpdating = True
End Sub
 
wampier zei:
Zoiets?

Code: 
Sub dedup()
    Application.ScreenUpdating = False
    Dim eerste As Range
    verg = ""
    huid = ""
    comb = "@^#"
    Set eerste = [a1]
    For Each regel In Range([b2], [b65000].End(xlUp))
        If regel.Offset(0, 1).Value <> "" Then
            verg = ""
            huid = ""
            Set eerste = [a1]
        Else
            huid = regel + comb + regel.Offset(0, 3) + comb + regel.Offset(0, 4)
            If huid = verg Then
                If eerste = [a1] Then
                    Set eerste = regel.Offset(-1, 5)
                End If
                eerste.Value = eerste.Value + regel.Offset(0, 5)
                regel.Offset(0, -1) = "#$VERW$#"
            Else
                verg = huid
                Set eerste = [a1]
            End If
        End If
    Next regel
    Do
        gevonden = False
        For Each regel In Range([b2], [b65000].End(xlUp))
            If regel.Offset(0, -1) = "#$VERW$#" Then
                regel.EntireRow.Delete
                gevonden = True
            End If
        Next regel
    Loop Until gevonden = False
    Application.ScreenUpdating = True
End Sub
Klik om te vergroten...

Beste,

Ik heb de code ingevoerd maar helaas wordt er niks uitgevoerd?

MVG
 
je moet de code met de hand starten natuurlijk ;) op de code gaan staan en het groene pijltje gebruiken op de ribbon
 
wampier zei:
je moet de code met de hand starten natuurlijk ;) op de code gaan staan en het groene pijltje gebruiken op de ribbon
Klik om te vergroten...

haha zo ver was ik zelf ook al dat ik hem moest starten :rolleyes:
Maar heb nog een andere code gevonden zal hem even delen hier:

Code:
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan