Som op basis van gelijke waardes in naastgelegen kolommen

Status
Niet open voor verdere reacties.
M

Mr Know-it-all

Gebruiker
Lid geworden
26 dec 2005
Berichten
24
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.
upload.png

Alle hulp welkom!

In de bijlage ook een voorbeeld bestandje.
 

Bijlagen

  • TFQ.xlsx
    11,1 KB · Weergaven: 26
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
 
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.
 
Het resultaat van de code is precies zoals jouw output.
 
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
 
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
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan