Új hozzászólás Aktív témák

• #36037 pigster senior tag lenkei83 #36029

  Új Válasz 2017-08-25 10:00:03 #36037

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  pigster

  senior tag

  válasz lenkei83 #36029 üzenetére

  Tools/References...-nél be kell jelölni a Microsoft Scripting Library-t a működéshez

  Function Gyujtes() As Scripting.Dictionary
Dim dict As Scripting.Dictionary

Dim myRange As Range
Dim sor As Long

Dim megnevezes As String
Dim ertek As Long

Set myRange = Range("A:B")
sor = 1

Set dict = New Scripting.Dictionary

megnevezes = myRange.Cells(sor, 1).Value
ertek = myRange.Cells(sor, 2).Value

Do While Not megnevezes = ""
If Not dict.Exists(megnevezes) Then
dict.Add megnevezes, ertek
Else
dict(megnevezes) = dict(megnevezes) + ertek
End If

sor = sor + 1
megnevezes = myRange.Cells(sor, 1).Value
ertek = myRange.Cells(sor, 2).Value
Loop
Set Gyujtes = dict
End Function



Sub Kiiras()
Dim dict As Scripting.Dictionary
Set dict = Gyujtes
Dim v As Variant

For Each v In dict.Keys
Rem persze a MsgBox helyett akármit lehet csinálni vele
MsgBox CStr(v) & " összesen: " & dict(v)
Next

End Sub

Új hozzászólás Aktív témák