Hirdetés
-
PROHARDVER!
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
-
Delila_1
veterán
Egy kicsit átalakítottam arra az esetre, ha nincs szükséged a laponkénti összegzésre, és a Data lapon egy összegben akarod látni az A14 cellában az összes lap megfelelő sorainak számát.
Sub Xek_1()
Application.ScreenUpdating = False
Dim sor, darab, lap, sor_data
darab = 0
For lap = 2 To Worksheets.Count
Sheets(lap).Select
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor, 4) = "y" And Cells(sor, 13) = "o" _
And Cells(sor, 17) = "x" Then darab = darab + 1
Next
Next lap
Sheets("Data").Cells(14, 1) = darab
Application.ScreenUpdating = True
End SubAz Application.ScreenUpdating = False sor leállítja a képernyő frissítését, az Application.ScreenUpdating = True pedig visszaállítja azt. Ezt azért tettem be, hogy ne zavarjon, hogy a program egyik lapról a másikra "ugrál".
-
Delila_1
veterán
Nem egészen tiszta, mit akarsz 114-szer átrakni.
Átírtam úgy a makrót, hogy a Data lapon gyűjti össze az adatokat az A2-től kezdve. Az A oszlopba beírja a munkalap nevét, mellé a B-be a darabszámot.
A Data lap legyen a füzetben az első helyen.Nagy különbség! A lapokon a Q oszlopban szereplő x szöveg, míg a makróban lévő szám. Hogy ne zavarjon az azonos kinézet, az x változó nevét átírtam darab-ra, de csak azért, hogy ne zavarjon.
Sub Xek()
Dim sor, darab, lap, sor_data
darab = 0
sor_data = 2
For lap = 2 To Worksheets.Count
Sheets(lap).Select
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor, 4) = "y" And Cells(sor, 13) = "o" _
And Cells(sor, 17) = "x" Then darab = darab + 1
Next
Sheets("Data").Cells(sor_data, 1) = Sheets(lap).Name
Sheets("Data").Cells(sor_data, 2) = darab
darab = 0
sor_data = sor_data + 1
Next lap
End Sub
Új hozzászólás Aktív témák
- Így fotóz és ennyire melegszik a Galaxy S26 Ultra
- Soundbar, soundplate, hangprojektor
- Autós topik
- Épített vízhűtés (nem kompakt) topic
- Avast! Antivirus topic
- Sötétvörös iPhone 18 Pro, ezüst-fekete iFold?
- Milyen Android TV boxot vegyek?
- Family Link
- GL.iNet Flint 2 (GL-MT6000) router
- Konzolokról KULTURÁLT módon
- További aktív témák...
- AKCIÓ!! HP Zbook Studio G8 i7-11850H 32GB 512GB Nvidia Quadro RTX A4000 8GB Garis!
- Ingyen elvihető hibás/törött TV/monitor
- Apple MacBook Pro 13 (2020) M1 8GB/256GB használt, megkímélt 90% akku (399 ciklus)
- HP EliteBook 840 G7 i5-10210U 16GB 256GB FHD 400nit 1 év garancia
- AKCIÓ! MSI Thin A15 B7VE FHD Gamer notebook - R5 7535HS 16GB DDR5 512GB SSD RTX 4050 6GB W11
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
