Hirdetés
- iPhone topik
- Bemutatkozott az Oppo kamerás csúcsmodellje
- Google Pixel 10 Pro XL – tíz kicsi Pixel
- VoLTE/VoWiFi
- Xiaomi 15T Pro - a téma nincs lezárva
- Egy picit megpihen az iPhone a 200 megapixeles váltás előtt
- Xiaomi 17 Ultra - jó az optikája
- Xiaomi 14T - nem baj, hogy nem Pro
- Samsung Galaxy A52s 5G - jó S-tehetség
- Nothing Phone 2a - semmi nem drága
-
Mobilarena
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
-
m.zmrzlina
senior tag
válasz
erich85T
#12573
üzenetére
Ha a valódi táblázatod is olyan szerkezetű mint a példa (nincs az ügyfelek oszlopában üres cella) akkor lehet ez egy megoldás:
Sub osszead()
Dim eredmeny As Double
Dim ugyfel As String
eredmeny = 0
Cells(2, 1).Select
ugyfel = ActiveCell.Value
Do Until ActiveCell.Value = ""
Do While ActiveCell.Value = ugyfel
eredmeny = eredmeny + ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 2).Value = eredmeny
eredmeny = 0
ugyfel = ActiveCell.Value
Loop
End SubNálam A1-től indul a táblázat.
-
bugizozi
őstag
válasz
erich85T
#12573
üzenetére
Esetleg részösszeg?
-
Delila_1
veterán
válasz
erich85T
#12018
üzenetére
A makró egy irányított szűréssel indul, ami az A oszlopban lévő neveket szűri meg úgy, hogy minden név csak egyszer szerepeljen az E oszlopban. Ezután a nevek mellé felsorolja az adatokat.
Sub mm()
Dim sor As Integer, usor As Integer, sor_név As Integer, usor_név As Integer
Dim név, oszlop As Integer
'Irányított szűrés az E oszlopba az egyedi nevekkel
Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"E1"), Unique:=True
usor = Range("E1").End(xlDown).Row: usor_név = Range("A1").End(xlDown).Row
'Kigyűjtés
For sor = 2 To usor
név = Cells(sor, "E"): oszlop = 6
For sor_név = 2 To usor_név
If Cells(sor_név, 1) = név Then
Cells(sor, oszlop) = Cells(sor_név, 2)
oszlop = oszlop + 1
End If
Next
Next
End Sub
Új hozzászólás Aktív témák
Hirdetés
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- HP. Laptop. i5. Model: 15-da1002nq
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- PC Game Pass előfizetés
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- GAMER PC! Ryzen 5600 / RTX 3060 12GB / A520M / 16GB DDR4 / 512GB NVMe!
- BESZÁMÍTÁS! MSI B550M R7 5700X 32GB DDR4 1TB SSD RTX 4070 12GB Lian Li Vector V100R FSP 650W
- ÁRGARANCIA! Épített KomPhone Ultra 7 265KF 32/64GB RAM RTX 5080 16GB GAMER PC termékbeszámítással
- Intel Core i3-8100/ i5-9500 / i7-8700 / i7-9700 /i5-10500T /i7-10700 processzorok- számla, garancia
- Apple MacBook Air 13" M4 (2025) 16GB / 256GB ezüst
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50
