-
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
Egyszerűbb lenne, ha telepítenéd a naptár vezérlőt, de itt egy ellenőrző makró. A (végül) bevitt dátumot az A1 cellába írja be.
Sub Dat_ellenorzes()
Dim kelt As String
kelt = Application.InputBox("Add meg dátumot", "Dátum bekérése", , , , , , 2)
'Ellenőrzés
'Teljes hossz
If Len(kelt) <> 10 Then GoTo Hiba
'Pontok helye
If Mid(kelt, 3, 1) <> "." Then GoTo Hiba 'nap
If Mid(kelt, 6, 1) <> "." Then GoTo Hiba 'hónap
'Szám-e
If Not IsNumeric(Left(kelt, 2)) Then GoTo Hiba 'nap
If Not IsNumeric(Mid(kelt, 4, 2)) Then GoTo Hiba 'hónap
If Not IsNumeric(Right(kelt, 4)) Then GoTo Hiba 'év
'Számok helyessége
If Left(kelt, 2) > "31" Then GoTo Hiba 'nap
If Mid(kelt, 4, 2) > "12" Then GoTo Hiba 'hónap
Select Case Mid(kelt, 4, 2) 'hónap
Case "02" 'február
If Right(kelt, 4) / 4 <> Int(Right(kelt, 4) / 4) And Left(kelt, 2) > 28 Then GoTo Hiba
Case "04", "06", "09", "11" '30 napos hónapok
If Left(kelt, 2) > 30 Then GoTo Hiba
End Select
If Right(kelt, 4) / 4 = Int(Right(kelt, 4) / 4) And Mid(kelt, 4, 2) = "02" _
And Left(kelt, 2) > 29 Then GoTo Hiba 'szökőév február
Range("A1") = CDate(kelt)
Exit Sub
Hiba:
Dat_ellenorzes
End Sub -
Delila_1
veterán
Az L vegyes értékeiből dátumot, ill. pontot hoz létre az M oszlopban:
Dim usor As Long
usor = Range("L" & Rows.Count).End(xlUp).Row
With Range("M2:M" & usor)
.FormulaR1C1 = "=IFERROR(DATEVALUE(MID(RC[-1],3,10)),""."")"
.Copy
.PasteSpecial xlPasteValues
.NumberFormat = "m/d/yyyy"
End With -
Delila_1
veterán
Az alprogramban akarsz utasításokat adni a főprogram ciklusán belül, valószínűleg a főprogram i vagy n változójának pillanatnyi értékével. Ha igen, akkor át kell adnod ezt az értéket a meghíváskor.
alprogramnev i
Az alprogramnak pedig fogadnia kell
Sub alprogramnev(i)
...
End Sub -
Delila_1
veterán
"mai nap és 3 nap közöttiek". Ma +3, vagy ma -3?
Tettem fel egy füzetet, ahol gombnyomásra irányított szűrővel kigyűjtöm a MA() ± 3 napos tételeket, ill. másik helyre azokat a sorokat, amik MA -3 napnál régebbiek, vagy MA +3 napnál újabbak. Adhatsz egy harmadikat, ami a mai dátum szerint szűr.
A szűrések nem módosítják az eredeti (A:C) tartományt, a szűrt állományokat oda másolhatod, ahova akarod.
-
Delila_1
veterán
Ha visszateszed a kiszűrteket, minek az egész?!
Ez a makró két lapra szedi szét a szükséges, és a törlendő sorokat.
Sub Torles()
Dim sor As Long, talal As Variant, usor As Long, ide As Long
Sheets("Eredeti").Select
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = usor To 2 Step -1
talal = Application.Match(Cells(sor, 1), Columns(12), 0)
If VarType(talal) = vbError Then
ide = Sheets("Ideiglenes").Range("A" & Rows.Count).End(xlUp).Row + 1
Rows(sor).Copy Sheets("Ideiglenes").Cells(ide, 1)
Range("A" & sor & ":D" & sor).Delete Shift:=xlUp
End If
Next
End Sub -
Delila_1
veterán
Nincs más hátra, soronként kell vizsgálódni.
Az A oszlop dátumai szerint keresek. Azokat a dátumokat, amiknek a sorát meg kell hagyni, az L oszlopban sorolom fel.
Sub Torles()
Dim sor As Integer, talal As Variant, usor As Integer
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = usor To 2 Step -1
talal = Application.Match(Cells(sor, 1), Columns(12), 0)
If VarType(talal) = vbError Then Rows(sor).Delete
Next
End Sub -
Delila_1
veterán
válasz
jackal79
#40792
üzenetére
Az INDEX függvény első paramétere a terület, amiben keresni akarsz. A második a sor meghatározása, ezt adjuk meg a HOL.VAN(MAX(...)) függvénnyel. A harmadik az oszlop, ahonnan a "soradik" értéket akarod meghatározni. Ebben az esetben ez 1, mivel a dátum az első oszlopban található.
-
Delila_1
veterán
Valószínű, hogy az R1C1 formátum tűnik bonyolultnak.
Úgy rémlik, valamikor ezen a fórumon írtam róla, keress rá.A makró majdnem teljesen makrórögzítésen alapult. A H2 képletét beírtam a füzetben, ezt rögzítettem. Azt is rögzítheted, mikor a képletet irányított beillesztéssel értékké alakítod.
Újabb rögzítés a villámkitöltés – ennek a VBA-s szintaktikáját nem ismertem.
Beírod a képletet az I2-be, rögzítés indítása, az I2-n állva a szerkesztőlécen leenterezed a képletet.
Ezután már csak kis igazításokra van szükség, mint az alsó sor meghatározása, és az I oszlopban a képletet 1 lépésben viheted be I2-től az I oszlop aljáig. -
Delila_1
veterán
Sub Datumok()
Dim usor As Long
With Range("H2")
'H2-be dátum képlete
.FormulaR1C1 = "=DATEVALUE(LEFT(RC[-1],10))"
'Képlet másolása és érték beillesztése irányítottan
.Copy
.PasteSpecial xlPasteValues
.NumberFormat = "m/d/yyyy" 'Cella formátuma
.FlashFill 'Villámkitöltés
End With
usor = Range("H" & Rows.Count).End(xlUp).Row 'alsó sor a H oszlopban
'Képlet I2-től I alsó sorig
Range("I2:I" & usor).FormulaR1C1 = _
"=IF(RC[-1]<TODAY(),""Régebbi"",IF(RC[-1]=TODAY(),"" Mai"",""Jövőbeni""))"
End SubNémi magyarázatot tettem az egyes sorokhoz.
-
Delila_1
veterán
Gyors eredményt érhetsz el, ha az oszlop melletti cellába beírod a dátumot (2019.04.02), majd az Adatok | Adateszközök | Villámkitöltés ikonra kattintasz. Ez az alatta lévő sorokba beírja a megfelelő dátumokat.
Nálam a belinkelt adataid az A-, a villámkitöltés a B oszlopban vannak.
Új oszlopba jön a képlet.=HA(B2<MA();"Régebbi";HA(B2=MA();"Mai";"Jövőbeni")) -
Delila_1
veterán
válasz
p5quser
#40640
üzenetére
Csak úgy ne járj, mint egykor a főnököm.
Egy hosszú jegyzőkönyvben sokszor le kellett írnom a zöld/sárga földelő vezeték szöveget. Nosza, automatikus javításba tettem, zs-ként. A főnöknek is átküldtem. Pár nap múlva kétségbe esve jött, hogy megbolondult nála az Excel. Mikor rövidítve leírja az egyik dolgozó nevét – Kovács Zsigmond helyett Kovács Zs – átíródik Kovács zöld/sárga földelő vezetékre. Eszerint a fájlom nála is bevezette az automatikus javítást.
-
Delila_1
veterán
válasz
p5quser
#40636
üzenetére
Jobban olvasható, ha nem off-ban írod, és ide is tartozik. Kijavítottam.

A Beállítások | Nyelvi ellenőrzés | Automatikus javítás | Automatikus javítás fülön beállíthatod a Módosítandó szöveget (pl. Tartal), a Jó szöveghez pedig beírod a teljeset (Tartalék akkumulátor mobiltelefonhoz). Beírja a Tartal szöveget, másik cellába lépve átíródik a "rendes" hosszúra. Kis- és nagybetűt figyeli!
Szerk.:
Ne adj módosítandónak értelmes szöveget, mert ha csak azt a szót akarod meghagyni, akkor is átírja a megadott jó szövegként. -
Delila_1
veterán
válasz
huliganboy
#40602
üzenetére
=HIPERHIVATKOZÁS([@ElérésiÚt];"Link")Nálam az elérési utak a fájl nevével együtt az ElérésiÚt című oszlopban vannak.
A @ jel adja meg, hogy a hivatkozással azonos sorról van szó. -
Delila_1
veterán
válasz
Lasersailing
#40588
üzenetére
=párose(sor()) és =páratlane(sor())
-
Delila_1
veterán
Ki sem jelöltem a táblázatot, csak benne álltam. Beszúrás, Diagramok, Vonal.
-
Delila_1
veterán
válasz
tgumis
#40459
üzenetére
Sub keplet_helyett_ertek()
Dim lap As Integer, akt_range As Range
For lap = 1 To Sheets.Count
Sheets(lap).Activate 'Lap aktívvá tétele
'Képleteket tartalmazó tartományok kijelölése
On Error Resume Next 'Hibakezelés, ha nincs képlet
Selection.SpecialCells(xlCellTypeFormulas, 23).Select
'A keletkezett területek bejárása és képlet-érték csere
For Each akt_range In Selection.Areas
akt_range.Formula = akt_range.Value
Next
On Error GoTo 0
Next
End Sub -
Delila_1
veterán
válasz
psycroptic
#40417
üzenetére
Nincs mit.

-
Delila_1
veterán
válasz
psycroptic
#40415
üzenetére
Az A3-ba
=HA(VAGY(A1>240;A2>240);"Túl nagy szám";"") -
Delila_1
veterán
Az adatok (táblák) közötti üres sorok növelik a fájl méretét.
Az FKERES függvény pontosítása nem a méretet csökkenti, hanem a számolási sebességet javítja.Egyszer kaptam egy olyan fájlt, aminél látszólag semmi nem indokolta a hirtelen megnövekedését. Volt egy olyan érzésem, hogy nem látható ábrák, képek vannak benne. Ez beigazolódott.
Behívtam az Ugrás menüt (Ctrl+g), ott az Irányított-tat választottam, majd az Objektumokat. Egy halom olyan képet jelölt ki, amik vonal szélességűre voltak összenyomva, ezért nem voltak láthatóak. A Delete billentyű egyszerre kitörölte az összeset, normál méretűre zsugorodott a fájl. Mint kiderült, a netről másolt be valamit a "gazdi", ez okozta a problémát.Hátha bejön, próbáld ki.
-
Delila_1
veterán
Sheets("Napi GY").Columns("AT:BG").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=ActiveSheet.Range("A1:A2"), CopyToRange:=ActiveSheet.Range("AQ3"), Unique:=FalseLátod, csak a kritérium, és a szűrés helyének a pontosítása szükséges. Mindkettőnél az aktív lapra kell hivatkoznod.
-
Delila_1
veterán
-
Delila_1
veterán
válasz
Dolphine
#40249
üzenetére
Igen, ez a lényeg. Az Excel alapvetően rekordokat (sorokat) tud úgy értelmezni, hogy azokból különféle statisztikákat, kimutatásokat lehessen létrehozni.
Ezzel a módszerrel a sok tanuló adatai áttekinthetőek lesznek.
Szűrőket is alkalmazhatsz, pl. hány tanuló teljesített a K1-ben maximálisan. -
Delila_1
veterán
Makróval:
Sub Vesszo()
Dim sor As Long
sor = 1
Do While Cells(sor, 1) > ""
If Cells(sor, "A") = Range("E1") Then
If Cells(1, "F") = "" Then
Cells(1, "F") = Cells(sor, "B")
Else: Cells(1, "F") = Cells(1, "F") & ", " & Cells(sor, "B")
End If
End If
If Cells(sor, "A") = Range("E2") Then
If Cells(2, "F") = "" Then
Cells(2, "F") = Cells(sor, "B")
Else: Cells(2, "F") = Cells(2, "F") & ", " & Cells(sor, "B")
End If
End If
sor = sor + 1
Loop
End SubA csatolt képen nem látszanak a sorszámok.
Ha az adatok nem az első sorban kezdődnek, a sor=1 sorban az 1 helyett a kezdő sorszámot add meg.
A két feltételnél is a Cells(1,"F") és aCells(2,"F")hivatkozásokat, no meg a Range("E1") és Range("E2")-t kell átírnod. -
Delila_1
veterán
válasz
tgumis
#40222
üzenetére
Egy laphoz rendelt, eseményvezérelt makrót javaslok. Nem írtad, melyik cellába írásakor változik az A1 IGAZ, vagy HAMIS értékre. A makróban ez a D3. Az írható cellák védelmét a makró indítása előtt le kell venned.
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="tgumis", UserInterfaceOnly:=True
If Target.Address = "$D$3" Then
If Range("A1") = True Then Range("C1").Locked = False Else Range("C1").Locked = True
End If
End SubOke: szívesen.
Új hozzászólás Aktív témák
- A fociról könnyedén, egy baráti társaságban
- Okos Otthon / Smart Home
- Xbox Series X|S
- Proxmox VE
- Mini PC
- Fejhallgató erősítő és DAC topik
- OLED TV topic
- Kodi és kiegészítői magyar nyelvű online tartalmakhoz (Linux, Windows)
- Nem lesz Redmi Note 16, évet ugrik a sorozat
- Az olcsó Macbook sokkolja a PC-ipart az ASUS társvezetője szerint
- További aktív témák...
- BESZÁMÍTÁS! AsRock H510M i5 11400 16GB DDR4 512GB SSD GTX 1070 8GB Zalman T3 Plus Chieftec 500W
- Keresünk iPhone 16/16e/16 Plus/16 Pro/16 Pro Max
- Ritkaság! Kékséges Nothing Phone 3A 12GB/256GB - 1 év garancia
- BESZÁMÍTÁS! 1TB Samsung 980 Pro NVMe SSD meghajtó garanciával hibátlan működéssel
- ÁRGARANCIA!Épített KomPhone Ryzen 7 5700X 32/64GB RAM RTX 5060 Ti 8GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest





