- iPhone topik
- Sony Xperia 1 VII - Látod-e, esteledik
- Samsung Galaxy A56 - megbízható középszerűség
- Azonnali navigációs kérdések órája
- Motorola Edge 50 Neo - az egyensúly gyengesége
- MIUI / HyperOS topik
- Google Pixel topik
- Milyen okostelefont vegyek?
- Honor Magic7 Pro - kifinomult, költséges képalkotás
- Yettel topik
-
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
Fferi50
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával - Nint.hu
- Assassin's Creed Shadows Collector's Edition PC
- Vírusirtó, Antivirus, VPN kulcsok
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Telefon felvásárlás!! Samsung Galaxy S23/Samsung Galaxy S23+/Samsung Galaxy S23 Ultra
- AKCIÓ! Apple Macbook Pro 16" 2019 i9 9980HK 64GB 500GB Radeon Pro 5500M notebook garanciával
- Apple iPhone 11 Pro 64GB, Kártyafüggetlen, 1 Év Garanciával
- Gamer Notebook! Csere-Beszámítás! Asus Rog Strix G731GU! 17,3Col! I7 9750H / GTX 1660Ti / 16GB DDR4
- LG 27GR93U-B - 27" IPS - UHD 4K - 144Hz 1ms - NVIDIA G-Sync - FreeSync Premium - HDR 400
Állásajánlatok
Cég: FOTC
Város: Budapest