-
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
-
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
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Antivírus szoftverek, VPN
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- MS SQL Server 2016, 2017, 2019
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- HIBÁTLAN iPhone 13 Pro Max 256GB Gold -1 ÉV GARANCIA - Kártyafüggetlen, MS3685
- ÁRGARANCIA! Épített KomPhone Ultra 9 285K 64GB RAM RX 9070 XT 16GB GAMER PC termékbeszámítással
- Telefon felvásárlás!! Samsung Galaxy A70/Samsung Galaxy A71/Samsung Galaxy A72
- iPhone 17 White 256 GB - Bontatlan !! www.stylebolt.hu - Apple eszközök és tartozékok - Számlás
- Apple iPhone 14 Pro 128GB,Újszerű,Dobozaval,12 hónap garanciával
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
