• 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.

Lijst inkorten door samenvoegen

Status
Niet open voor verdere reacties.
U

UnnamedNL

Gebruiker
Lid geworden
2 dec 2009
Berichten
22
Goedemorgen Helpmij forumleden,

In een reeds gesloten forum
https://www.helpmij.nl/forum/showthread.php/937643-Lijst-inkorten-door-samenvoegen?highlight=inkorten
heb ik jullie hulp gevraagd om de lijst in te korten.
Dit gaat prima alleen kijken we hierbij naar 1 criterium.
Ik zou graag de lijst willen inkorten, samenvoegen en optellen wanneer alle cellen in de rij A t/m J gelijk zijn.
Bekijk bijlage COUNT IF.xlsm
Volgens mij moet de macro worden aangepast bij de formule COUNTIF => COUNTIFS ?

Ik hoop dat jullie mij hierbij kunnen helpen.

Groet Barend
 
Code: 
Sub Macro1()
  Sheets("Blad1").Cells(1).CurrentRegion.Columns(1).Name = "bereik"
  [bereik].Offset(, 10) = [if(row(bereik),countif(bereik,bereik))]
  [bereik].Resize(, 11).RemoveDuplicates Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
End Sub
 
Harry,

Bedankt voor je reactie. Het verwijderen van de duplicaten gaat goed.:thumb:
Het optellen gaat nog niet goed. Nu wordt alleen naar de eerste kolom gekeken.
Ik zou graag willen dat er wordt opgeteld wanneer de cellen in de rij A t/m J gelijk zijn.

Ik hoor graag nog het laatste onderdeel.

Groet Barend
 
Test het zo eens.
Code: 
Sub Macro1()
Dim sv, i As Long
sv = Cells(1).CurrentRegion.Columns(1).Resize(, 10)
  With CreateObject("scripting.dictionary")
     For i = 1 To UBound(sv)
      .Item(Join(Application.Index(sv, i, 0))) = .Item(Join(Application.Index(sv, i, 0))) + 1
     Next i
    Cells(1, 11).Resize(.Count) = Application.Transpose(.items)
  End With
 Cells(1).CurrentRegion.Columns(1).Resize(, 10).RemoveDuplicates Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
End Sub
 
Graag gedaan en insgelijks.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan