Hirdetés
- Yettel topik
- Poco X8 Pro Max - nem kell ide sem bank, sem akkubank
- iPhone topik
- Samsung Galaxy S26 Ultra - fontossági sorrend
- MWC 2026: Bajnoki címre pályázik a Xiaomi Watch 5
- Google Pixel 10 Pro XL – tíz kicsi Pixel
- Google Pixel topik
- Nemzetközi vizekre evezett a Realme GT 7 és GT 7T
- Külföldi prepaid SIM-ek itthon
- Samsung Galaxy A52s 5G - jó S-tehetség
-
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
-
-
Delila_1
veterán
Egy halom idézőjelet tettél bele feleslegesen, és a $-t kihagytad.
Jelöld ki az A2:F4 területet. A formázás képlete: =$E2="nem"
Add meg a formátumot, és kész. Új szabály, ugyanez a képlet, csak a "nem" helyére "igen" jön, és a háttér zöld.A további sorokra a formátumfestő ecsettel másolhatod a formátumot, vagy a feltételes formázás | Szabályok kezelése ablakában egyszerűen átírod az érvényességet a teljes területedre.
-
Delila_1
veterán
Érvényesítésben add meg a két választható elemet.
A feltételes formázásnál erre a cellára kell hivatkoznod. Ha pl. a B oszlopban van az érvényesítés, az adatok meg A2-től Q1000-ig, akkor kijelölöd a teljes területet. A feltételes formázáshoz 2 képletet vigyél be.
=$B2="igen" és =$B2="nem". A két képlethez külön add meg a két háttérszínt. Fontos a $ jel az érvényesítést tartalmazó oszlop betűjele előtt. -
-
Delila_1
veterán
A működéshez tedd meg az alábbi lépéseket:
Office gomb, Az Excel beállításai, Bővítmények. Balra lent a Kezelések közül Excel bővítmények, Ugrás, a kapott felsorolás első két bővítménye elé tegyél pipát, OK.Az első (gyűjtő) lapodhoz rendelve marad a
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then karbantart
End Submakró, ami figyeli az A1 cella változását.A modulba kerül a másik makró,
Sub karbantart()
Dim sorGy%, lap%, sorLap%, usorLap%
sorGy% = 2
Sheets(1).Select
Rows("2:10000").ClearContents
For lap% = 2 To Worksheets.Count
Sheets(lap%).Select
usorLap% = Sheets(lap%).Range("A50000").End(xlUp).Row
For sorLap% = 2 To usorLap%
If Cells(sorLap%, 5) + Cells(sorLap%, 6) <= Sheets(1).Cells(1) Then
Range(Cells(sorLap%, 1), Cells(sorLap%, 6)).Copy Sheets(1).Cells(sorGy%, 1)
sorGy% = sorGy% + 1
End If
Next
Next
Sheets(1).Select
End Subami a kigyűjtést végzi. A számítás alapja, hogy az egyes lapokon az utolsó karbantartás idejéhez hozzáadja a következő karbantartáshoz szükséges napokat (E+F), és ha ez a nap kisebb, vagy egyenlő, mint a gyűjtő lap A1 cellájába írt dátum, akkor bemásolja az egyes alkatrészek adatait a lapokról az A:F oszlopokból.
-
perfag
aktív tag
Dolgom volt du., közben látom Delila már adott rá megoldást, de ha már kész, ide teszem.
Sub copy_data()
Dim rng As Range
Dim tcell As Range
Dim w, i, j, k As Integer
'előkészítés
j = 1 'célcella számláló
k = 2 'dátum oszlop távolsága jobbról
'a gyűjtőlapon C4-be kezd adatot áthozni
Set tcell = Worksheets(1).Range("C4")
'de előbb lefelé 100 cellának törli a tartalmát
Range(tcell(1), tcell(100)).ClearContents
'munkalapok
For w = 2 To 6
'az adatok D3:D8-ban
Set rng = Worksheets(w).Range("D3:D8")
'vizsgáódás, másolás
For i = 1 To 5
If Not rng(i) = Empty Then
'a mai naphoz képest mi régebbi, mint 3 hónap,
'ám én inkább 90 napot használnék:
'If DateDiff("d", rng(i, k), Now) >= 90 Then
If DateDiff("m", rng(i, k), Now) >= 3 Then
tcell(j) = rng(i)
j = j + 1
End If
End If
Next
Next -
Delila_1
veterán
Az két makró ezt csinálja:
Ha az első lap A1 cellájába beírod a dátumot, automatikusan indul a kigyűjtés erre a lapra, A2-től kezdődően. A beírás indítja az első makrót, ami nekilódítja a másikat.Az utóbbi végigszalad a másodiktól az utolsó lapig. Minden lapon végignézi az A oszlopban tárolt dátumokat soronként (amik feltehetően az utolsó karbantartás dátumai).
Ahol az első lap A1-es dátumánál 90 nappal, vagy annál régebbi dátumot talál, a sor első 15 oszlopát (A:O oszlopok) átmásolja az első lapra egymás alá.Ahhoz, hogy automatikusan induljon a kért dátum beírásakor, 2 makró szükséges.
Az elsőt a gyűjtő (első) laphoz rendeld, a másodikat modulba.Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then karbantart
End Sub
.
Sub karbantart()
Dim sorGy%, lap%, sorLap%, usorLap%
sorGy% = 2
Rows("2:10000").ClearContents
For lap% = 2 To Worksheets.Count
Sheets(lap%).Select
usorLap% = Sheets(lap%).Range("A65000").End(xlUp).Row
For sorLap% = 2 To usorLap%
If Sheets(1).Cells(1) - Sheets(lap%).Cells(sorLap%, 1) >= 90 Then
Range(Cells(sorLap%, 1), Cells(sorLap%, 15)).Copy Sheets(1).Cells(sorGy%, 1)
sorGy% = sorGy% + 1
End If
Next
Next
Sheets(1).Select
End SubHa több oszlopod van, mint 15, a
Range(Cells(sorLap%, 1), Cells(sorLap%, 15)).Copy Sheets(1).Cells(sorGy%, 1)
sorban írd át a 15-öt. -
perfag
aktív tag
Mondjuk nem tudom mekkora alkatrész bázissal dolgozol, de meg lehet kerülni a makrót. Először is a dátumok közötti különbséget kell kezelni, innen el lehet indulni:
Dátumok és időpontok használata az Excel programban
"az első lapra azoknak az alkatrészeknek a nevét kiírná amik karbantartásra szorulnak." ehhez egy gyűjtögető makró kellene, de minek. Szerintem meg lehetne oldani, hogy az első lapon egy oszlopban megjelennek az alkatrésznevek, mellettük meg az eltelt idő. Vagy egyszerű sorba rendezéssel kigyűjtheted a szükséges alkatrészeket, vagy feltételes formázással mondjuk piros lesz azoknak az alkatrészeknek a neve ahol matatni kell.
). Kettőnél viszont már tudja, hogy csak egy bizonyos területen akarod végrehajtani a műveletet.
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- Játékkulcsok olcsón: Steam, Uplay, GoG, EA, Xbox stb.
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Apple MacBook Pro 13" M2 (2022) 8GB / 256GB asztroszürke
- ÁRGARANCIA!Épített KomPhone i5 14600KF 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
- ThinkPad T14s Gen 2 i5-1135G7 16GB 512GB FHD 1 év garancia
- BESZÁMÍTÁS! Apple Macbook Air 13 M4 16GB RAM 256GB SSD notebook garanciával hibátlan működéssel
- Lian Li Strimer Plus V2 12VHPWR 320mm RGB tápkábel
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest