- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Fujifilm X
- Mikrokontrollerek Arduino környezetben (programozás, építés, tippek)
- Apple MacBook
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- Kettő együtt: Radeon RX 9070 és 9070 XT tesztje
- OLED TV topic
- TCL LCD és LED TV-k
- Azonnali alaplapos kérdések órája
- Nyárbúcsúztató hardvermix
-
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 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- Nothing Headphone (1) – nem kell ide idézet
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- PROHARDVER! feedback: bugok, problémák, ötletek
- Formula-1
- Autós topik
- Fujifilm X
- iPhone topik
- Kerékpárosok, bringások ide!
- Mikrokontrollerek Arduino környezetben (programozás, építés, tippek)
- Xiaomi 15 - kicsi telefon nagy energiával
- További aktív témák...
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Assassin's Creed Shadows Collector's Edition PC
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- HIBÁTLAN Apple Watch Ultra 2 Natural Titanium 49mm -1 ÉV GARANCIA - 100% Akkumulátor, MS3220
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Bomba ár! Acer Aspire E5 - i7-7GEN I 8GB I 128GB SSD I 15,6" FHD I Nvidia 2GB I Cam I W11 I Gari!
- Telefon Felvásárlás!! iPhone 14/iPhone 14 Plus/iPhone 14 Pro/iPhone 14 Pro Max
- billentyűzetek - kiárusítás - Logitech, Corsair, ASUS
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft.
Város: Budapest