-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
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[ Szerkesztve ]
FIGYELEM! A többszázezres Samsung okostévék kéretlen reklámokat tolnak az arcodba.
Új hozzászólás Aktív témák
- Steames kulcsok jó áron eladóak!
- Windows 10/11 Home/Pro , Office OEM/Retail kulcsok
- Adobe Creative Cloud - 2024. 04. 05 - 2025. 04. 05-ig
- Microsoft licencek a KIVÉTELES ÁRAK - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Game Pass Ultimate előfizetések 1 - 25 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN!