- Motorola Edge 50 Neo - az egyensúly gyengesége
- Hívószám-hamisítás
- Magisk
- One mobilszolgáltatások
- iPhone topik
- Íme az új Android Auto!
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Szívós, szép és kitartó az új OnePlus óra
- Samsung Galaxy Fit 3 - keveset, de jól
- Honor Magic6 Pro - kör közepén számok
-
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
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Milyen billentyűzetet vegyek?
- Motorola Edge 50 Neo - az egyensúly gyengesége
- Torrent meghívó kunyeráló
- Gamepad
- Autós kamerák
- Napelem
- Mibe tegyem a megtakarításaimat?
- Rágyúr a macOS-re a 3DMark
- További aktív témák...
- Amazon Kindle 10th Generation ébresztős tok
- Telefon felvásárlás!! iPhone 12 Mini/iPhone 12/iPhone 12 Pro/iPhone 12 Pro Max
- ASUS TUF Gaming F15 FX506 - 15.6"FHD IPS 144Hz - i5-11400H - 8GB - 512GB - RTX 3050 Ti - 1,5 év gari
- Realme 7i 64GB, Kártyafüggetlen, 1 Év Garanciával
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest