- Megérkezett a Google Pixel 7 és 7 Pro
- Honor Magic V5 - méret a kamera mögött
- Samsung Galaxy Z Fold7 - ezt vártuk, de…
- Vivo X200 Pro - a kétszázát!
- Yettel topik
- Samsung Galaxy A56 - megbízható középszerűség
- Samsung Galaxy Watch7 - kötelező kör
- Milyen okostelefont vegyek?
- Új Trónok Harca telefon érkezik
- Magisk
Hirdetés
-
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
- Sütés, főzés és konyhai praktikák
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Vezetékes FÜLhallgatók
- Megérkezett a Google Pixel 7 és 7 Pro
- Milyen CPU léghűtést vegyek?
- sziku69: Szólánc.
- TCL LCD és LED TV-k
- Honor Magic V5 - méret a kamera mögött
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- További aktív témák...
- PC Game Pass előfizetés
- Eladó Steam kulcsok kedvező áron!
- Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával - Nint.hu
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Bomba ár! Lenovo X1 Yoga 1st - i7-6G I 8GB I 256SSD I 14" WQHD I HDMI I W10 I CAM I Garancia!
- Xbox Ultimate előfizetések
- LG UltraGear Gaming Monitorok -30%
- Bezámítás! Gigabyte G5 KC Gamer notebook - i5 10500H 16GB DDR4 512GB SSD RTX 3060 6GB WIN10
- BESZÁMÍTÁS! MSI B550M R7 5700X 32GB DDR4 1TB SSD RTX 4070 12GB NZXT H710I Be Quiet 650W
Állásajánlatok
Cég: FOTC
Város: Budapest