Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 7 van 7

Onderwerp: Som op basis van gelijke waardes in naastgelegen kolommen

  1. #1
    Vraag is niet opgelost

    Som op basis van gelijke waardes in naastgelegen kolommen

    Hallo eenieder,

    Ik probeer met VBA in een lijst de som van het aantal Motorcycles A en Motorcycles B in een nieuwe rij te krijgen. Het moet per ruimte die in kolom D staat in dit voorbeeld.

    Dus zoiets als dit:

    Links de input en rechts wat het moet worden.
    Klik op afbeelding voor grotere versie

Naam:  upload.png
Bekeken: 20
Grootte:  71,4 KB

    Alle hulp welkom!

    In de bijlage ook een voorbeeld bestandje.
    Bijgevoegde bestanden Bijgevoegde bestanden

  2. #2
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Code:
    Sub hsv()
    Dim sv, i As Long, a, b(3)
    sv = Cells(1).CurrentRegion.Resize(, 4)
    With CreateObject("scripting.dictionary")
      For i = 2 To UBound(sv)
       a = .Item(sv(i, 2) & sv(i, 4))
         If IsEmpty(a) Then a = b
            a(0) = a(0) + sv(i, 1)
            a(1) = sv(i, 2)
            a(3) = sv(i, 4)
         .Item(sv(i, 2) & sv(i, 4)) = a
      Next i
     Sheets("output").Cells(2, 10).Resize(.Count, 4) = Application.Index(.items, 0, 0)
     End With
    End Sub
    ____________
    Met vriendelijke groet,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  3. #3
    Bedankt Harry!

    Het enige wat hier nog niet goed gaat is dat A en B bijelkaar opgeteld worden als motorcyles AB maar ik denk dat ik daar wel uit ga komen.

    Heel erg bedankt.

  4. #4
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Het resultaat van de code is precies zoals jouw output.
    ____________
    Met vriendelijke groet,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  5. #5
    Niet helemaal volgens mij hoor,

    Ik krijg dit als output:

    Klik op afbeelding voor grotere versie

Naam:  aa.png
Bekeken: 11
Grootte:  32,8 KB

  6. #6
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Met een paar aanpassingen in de code

    Code:
    Sub hsv()
    Dim sv, i As Long, a, b(3), c00 As String
    sv = Sheets("Input").Cells(1).CurrentRegion.Resize(, 4)
    Set d = CreateObject("scripting.dictionary")
      For i = 2 To UBound(sv)
      If sv(i, 2) = "Motorcycle A" Or sv(i, 2) = "Motorcycle B" Then c00 = "Motorcycles AB" Else c00 = sv(i, 2)
      a = d(c00 & sv(i, 4))
         If IsEmpty(a) Then a = b
            a(0) = a(0) + sv(i, 1)
            a(1) = c00
            a(3) = sv(i, 4)
         d(c00 & sv(i, 4)) = a
      Next i
     Sheets("output").Cells(2, 10).Resize(d.Count, 4) = Application.Index(d.items, 0, 0)
    End Sub
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  7. #7
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Code:
    Sub hsv()
    Dim sv, i As Long, a, b(3), c00 As String
    sv = Sheets("input").Cells(1).CurrentRegion.Resize(, 4)
    With CreateObject("scripting.dictionary")
      For i = 2 To UBound(sv)
      c00 = IIf(InStr("Motorcycle A Motorcycle B", sv(i, 2)), "Motorcycle AB", sv(i, 2))
       a = .Item(c00 & sv(i, 4))
         If IsEmpty(a) Then a = b
            a(0) = a(0) + sv(i, 1)
            a(1) = c00
            a(3) = sv(i, 4)
         .Item(c00 & sv(i, 4)) = a
      Next i
     Sheets("output").Cells(2, 10).Resize(.Count, 4) = Application.Index(.items, 0, 0)
     End With
    End Sub
    ____________
    Met vriendelijke groet,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren