-
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
-
Mutt
senior tag
Hello,
Ezt: [link] hogyan tudnám úgy átalakítani, hogy ne cellánként számoljon, hanem egy teljes tartományt? A teljes A oszlopon szeretném használni.
Erre nem láttam választ, de két sort plusz kell. Itt az új kód.
Function SumNums(cell As Range, Optional strDelim As String = " ") As Double
Dim vNums As Variant, lngNum As Long, rngS As Range
For Each rngS In cell 'új sor a tartományhoz
vNums = Split(rngS, strDelim)
For lngNum = LBound(vNums) To UBound(vNums) Step 1
If InStr(1, vNums(lngNum), ",") > 0 Then vNums(lngNum) = Replace(vNums(lngNum), ",", ".")
SumNums = SumNums + Val(vNums(lngNum))
Next lngNum
Next rngS 'új sor a tartományhoz
End FunctionHa a teljes A-oszlophoz akarod használni, akkor be tud lassulni, mert az üres mezőket is kiértékeli ezért érdemes plusz ellenőrzést ennek elkerülésére beletenni. Továbbá tuningolható, hogy a tizedesvesszőt tartalmazó számokat is kezelni tudja.

Function SumNums(cell As Range, Optional strDelim As String = " ") As Double
Dim vNums As Variant, lngNum As Long, rngS As Range
Dim workrange As Range
Set workrange = Intersect(ThisWorkbook.Sheets(cell.Parent.Name).UsedRange, cell)
For Each rngS In workrange 'új sor a tartományhoz
vNums = Split(rngS, strDelim)
For lngNum = LBound(vNums) To UBound(vNums) Step 1
If InStr(1, vNums(lngNum), ",") > 0 Then vNums(lngNum) = Replace(vNums(lngNum), ",", ".") 'tizedesvessző kezelés
SumNums = SumNums + Val(vNums(lngNum))
Next lngNum
Next rngS 'új sor a tartományhoz
End Functionudv
Új hozzászólás Aktív témák
- CURVE - "All your cards in one." Minden bankkártyád egyben.
- Suzuki topik
- iPhone topik
- Meggyi001: Áram nélkül....méltóság nélkül.....
- exHWSW - Értünk mindenhez IS
- Milyen TV-t vegyek?
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Szünetmentes tápegységek (UPS)
- Kötelező frissítésnek számít a Microsoft legújabb csomagja a Windows 11-hez
- Hálózati / IP kamera
- További aktív témák...
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- PC Game Pass előfizetés
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- AKCIÓ! ÚJ ASUS TUF GAMING Geforce RTX 5080 OC Edition 16GB VRAM Ray Tracing DLSS4
- Lenovo T15 G2 i7-1185G7 16Gb ram, 512Gb NVMe, 15,6", számla, 1 év garancia
- Dell Latitude 5490 14",FHD,i5-8350U,8GB,256GB SSD,WIN11
- 180 - Lenovo LOQ (15IRX9) - Intel Core i7-13650HX, RTX 4060
- 16GB DDR4 RAM modulok 3200Mhz több darab // Számla // Garancia //
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50