- Xiaomi 14T - nem baj, hogy nem Pro
- Motorola Razr 60 Ultra - ez a kagyló könnyen megfő
- Apple iPhone 16 Pro - rutinvizsga
- iPhone topik
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Az Oppo Find X8 Ultra lett a legvékonyabb kameramobil
- Apple Watch
- Honor Magic7 Pro - kifinomult, költséges képalkotás
- Íme az új Android Auto!
- Samsung Galaxy S20 és S20+ duplateszt
-
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
-
Mutt
senior tag
válasz
T.Lacci #19775 üzenetére
Hello,
A makrót fel tudod gyorsítani a következőkkel:
1. képérnyőfrissítés kikapcsolása (ScreenUpdating)
2. események letiltása (EnableEvents)
3. objektumok létrehozása (Set parancs)
4. változók definiálása konkrét típussal (Variant mellőzése)
5. beépített függvények használata (pl. Sum egy saját összegzés helyett)
6. üres cellák ignorálásaEgy 100 ezer darabos halmazon futtattam a különböző variációkat az eredmények:
Könnyedén gyorsítható tehát az első 2 opcióval.
Sub Szorzas()
Dim tartomany As Range, cella As Range, szorzo As Double
Set tartomany = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each cella In tartomany
'Feltételek megdása
Select Case cella.Value
Case 1 To 10000
szorzo = 1.4
Case 10001 To 20000
szorzo = 1.3
Case 20001 To 30000
szorzo = 1.2
Case Else
szorzo = 0.9
End Select
'Szorzat beírása az E oszlopba
Cells(cella.Row, "E") = cella.Value * szorzo
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End SubA függvényest pedig a 19740-es hozzászólásban találod.
üdv
-
Delila_1
veterán
-
-
Mutt
senior tag
válasz
T.Lacci #19737 üzenetére
Hello,
Különben az miért van hogy nem teljesen pontosan számol? (1000 x 1,4 = 1,399999999)
A kapott makróban a szorzo változót Single típusról Double típusra állítsd át.
...a táblázatomnak szöveges fejléce van...
A For sor = 1 To usor részben az 1-est írd át 2-re (vagy arra a sorra ahonnan a számok kezdődnek).
Az eredeti feladat nem követel makrót, akár egy FKERES segítségével is megoldható.
pl. E1-be: =D1*FKERES(D1;{0\1,4;10001\1,3;20001\1,2;30001\1,1};2)Itt a kapcsos zárójelekben van a keresési tartomány, 0 és 10000 között 1,4-et talál meg, 10001 felett 1,3-at és így tovább,
Ha mégis makró kell, akkor itt van egy gyorsabb:
Sub Szorzas2()
Dim rng As Range
'kiválasztjuk a csak számokat tartalmazó cellákat a D-oszlopban
Set rng = Columns("D").SpecialCells(xlCellTypeConstants, xlNumbers)
'jobbra tőlük számoljuk az új értéket; fkeres hasonló mint fent de a vba miatt máshogy kell megadni
rng.Offset(, 1).FormulaR1C1 = "=RC[-1]*VLOOKUP(RC[-1],{0,1.4;10001,1.3;20001,1.2;30001,1.1},2)"
'értékeket bemásoljuk
Columns("E").Copy
Columns("E").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End Subüdv
-
Delila_1
veterán
válasz
T.Lacci #19707 üzenetére
Sub Szorzas()
Dim sor As Long, usor As Long, szorzo As Single
'Alsó sor meghatározása a D oszlopban)
usor = Range("D" & Rows.Count).End(xlUp).Row
'Ciklus az elsőtől az utolsó sorig
For sor = 1 To usor
'Feltételek megdása
Select Case Cells(sor, "D")
Case 1 To 10000
szorzo = 1.4
Case 10001 To 20000
szorzo = 1.3
Case 20001 To 30000
szorzo = 1.2
Case Else
szorzo = 0.9
End Select
'Szorzat beírása az E oszlopba
Cells(sor, "E") = Cells(sor, "D") * szorzo
'Ha kerekítve akarod megadni a szorzatot, a fenti helyett
'a lenti sort alkalmazd a szorzásra
'Cells(sor, "E") = Round(Cells(sor, "D") * szorzo, 0)
Next
End SubA Case sorokat folytathatod. A Case Else sorhoz azt az utasítást add, ami azokra az összegekre vonatkozik, amikhez a fölötte lévő feltételekben nem határoztál meg szorzót. Ki is hagyható.
Figyelj, hogy a szorzók tizedes ponttal, nem veszővel írandók a makróban! -
Delila_1
veterán
válasz
T.Lacci #19601 üzenetére
ter.Replace What:="Gipszkarton", Replacement:="25-0-0-0", lookat:=xlWhole
ter.Replace What:="Gipszkarton tartozékok", Replacement:="120-0-0-0", lookat:=xlWholeHa a végéről lemarad a , lookat:=xlWhole, akkor csinálja azt, amit írtál, mert alapból az xlpart opciót hajtja végre.
Az xlpart rész szöveget cserél, xlwhole teljes cellát.
Új hozzászólás Aktív témák
Hirdetés
- Xiaomi 14T - nem baj, hogy nem Pro
- Motorola Razr 60 Ultra - ez a kagyló könnyen megfő
- Apple iPhone 16 Pro - rutinvizsga
- Synology NAS
- OLED TV topic
- One otthoni szolgáltatások (TV, internet, telefon)
- Revolut
- iPhone topik
- Mielőbb díjat rakatnának a görögök az olcsó csomagokra az EU-ban
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- További aktív témák...
- 115.000 ft -tól Országosan a legjobb BANKMENTES részletfizetési konstrukció! ASUS ROG Strix G18
- Samsung Galaxy J6 2018 32GB, Kártyafüggetlen, 1 Év Garanciával
- AKCIÓ! "ÚJ" Microsoft Surface 5 13,5 notebook - i5 1235U 8GB RAM 256GB SSD Intel Iris Xe IGP 27% áfa
- 3DKRAFT.HU - 3D NYOMTATÁS - AZONNALI ÁRAJÁNLAT - GYORS KIVITELEZÉS - 480+ POZITÍV ÉRTÉKELÉS
- LG 27GR95QE - 27" OLED / QHD 2K / 240Hz & 0.03ms / NVIDIA G-Sync / FreeSync Premium / HDMI 2.1
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: CAMERA-PRO Hungary Kft
Város: Budapest