-
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
A kiegészítés, ha az összeg A1-ben szerepel:
=jobb("0000000000000"&A1;13)
Angolban:
=right("0000000000000"&A1;13)Ez összefűzi a halom nullát és a számot, majd veszi annak a jobboldali 13 karakterét. Ezután azonban nem lehet vele számolni, mert szövegként értelmezi.
Ha számolni is akarsz vele, a cellaformátumnál, az egyéni kategóriában kell megadnod:
000000000000# (12 db 0, és 1 db #). -
Delila_1
veterán
Sub szaznal_nagyobb()
For sor = 2 To 20 '20 helyett az utolsó sor kell
For oszlop = 2 To 7 '7 helyett az ucsó oszlop sorszáma (A=1, B=2, C=3)
If Cells(sor, oszlop).Value > 100 Then
Range(Cells(sor, 2), Cells(sor, oszlop)).Select
Selection.ClearContents
End If
Next
Next
End Sub -
Delila_1
veterán
Most látom, hogy teljesen félreértettem a feladatot.
Van egy táblázatod, ami A1-től ???-ig tart.
Ebben itt-ott vannak 100-nál nagyobb értékek. Ha ez először C5-ben fordul elő, akkor törölni kell az értékeket B5-től C5-ig (nem A5-től, mert A5-ben a sor neve van).
Így gondolod? -
-
Delila_1
veterán
=A1*(1+5%)
Ezt másold végig az adataid mellett.
Ha az értékeket fixre akarod venni (ne képlet legyen), akkor a növelt értékeket tartalmazó cellákat kijelölöd, másolod, és Szerkesztés/Irányított beillesztés/Értéket beilleszt – másik helyre, vagy az eredeti összegek helyére. -
Delila_1
veterán
A soradik (aktuális sor) 7. (G) oszlopában levő értéket, annak is a jobboldali 2 karakterét.
Ezt teszi be a nev változóba.
Azután az esetleges mínusz jel miatt tovább vizsgálja. Ha a két karakterből álló nev baloldali 1 karaktere – left(nev,1) – kettőspont, akkor a nev jobboldali 1 karakterét veszi alapul, egyébként pedig a teljes nev változót (pl. -1). -
Delila_1
veterán
Ha már Amanozas így megbízik bennem, itt a makró. (Igazad van Amazonas, körkörös hivatkozás lenne).
Sub mem()
Range("G1").Select
Selection.End(xlDown).Select
usor = Selection.Row
For sor = 1 To usor
nev = Right(Cells(sor, 7).Value, 2)
If Left(nev, 1) = ":" Then nev = Right(nev, 1)
Cells(sor, 7) = nev
Next
End Sub -
Delila_1
veterán
Másik módja az utolsó sor, ill. utolsó oszlop megkeresésének, arra az esetre, ha a lapon több, egymástól üres sorokkal, oszlopokkal elválasztott adataink vannak:
Kiválasztjuk egy olyan oszloponak az első celláját, amelyikben biztosan folyamatosan vannak az adatok, pl. A1.
Range("A1").Select
Selection.End(xlDown).Select ' ez azonos azzal, mint amikor Ctrl+le-nyilat nyomunk
usor = Selection.Row
Range("A1").Select
Selection.End(xlToRight).Select ' Ctrl+jobbra-nyílnak felel meg
uoszlop = Selection.ColumnHa biztos, hogy az alsó sorban minden oszlopban van adat, a második Range-re nincs szükség.
-
Delila_1
veterán
Igen, és az utolsó sor értékét a fölötte lévő sor adja.
Vigyázni kell arra, hogy ha voltak az aktív táblázat területén kívül eső cellákban valamikor értékek (most már törölve vannak - szépen magyarul), vagy most is vannak benne kósza adatok, akkor azokkal a címekkel számol a makró, és hamis értéket ad.
A makróba érdemes egy stoppot tenni a két érték bekérése után, és ellenőrizni. Ha többet mutat az usor és az uoszlop nevű változó a kelleténél, a felesleges sorokat és oszlopokat törölni kell. Nem a benne lévő adatot, hanem a teljes sort ill. oszlopot. -
Delila_1
veterán
Másold be az alábbi makrót:
Sub Atlag()
Sheets("Munka1").Select
usor = ActiveSheet.UsedRange.Rows.Count
uoszlop = ActiveSheet.UsedRange.Columns.Count
Sheets("Munka2").Select
For sor = 2 To usor
Cells(sor, 1).Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Munka1!RC[" & uoszlop - 3 & _
"]:RC[" & uoszlop - 1 & "])"
Next
End SubA Munka1 lap 3 utolsó oszlopát átlagolja a Munka2 A oszlopába.
Ha B oszlopba kell az átlag, a Cells(sor,1)-et írd át Cells(sor,2)-re, és az ActiveCell.FormulaR1C1 kezdetű sorban az uoszlop-3 és uoszlop-1 értékeket is növeld eggyel (uoszlop-3 és uoszlop-2). -
Delila_1
veterán
A With sorban megadunk egy objektumot, amire a változtatások vonatkoznak. Jelen esetben a kijelölt terület (selection) hátterét (interior). A további sorok ponttal kezdődnek, amit úgy kell értelmezni, mintha a With sorban írtakat folytatnánk (With nélkül):
selection.interior.colorindex=15
selection.interior.pattern=xlsolid 'nincs mintázat
selection.interior.patterncolorindex=xlautomatic 'a mintázat színeA két utóbbi kitörölhető, mivel alapbeállítás, és akkor már nincs szükség a With, End With-ra sem.
Ezt a makrót most rögzítettem, a karakter típusát változtattam meg. '******-gal jelöltem, ami nem szükséges, törölhető.
With Selection.Font
.Name = "Tahoma"
.Size = 10 '******
.Strikethrough = False '******
.Superscript = False '******
.Subscript = False '******
.OutlineFont = False '******
.Shadow = False '******
.Underline = xlUnderlineStyleNone '******
.ColorIndex = xlAutomatic '******
End WithVégül ennyi marad: Selection.Font.Name = "Tahoma"
-
Delila_1
veterán
cells(x,25).select
selection.font.colorindex=színkód 'karater színe
selection.interior.colorindex=színkód 'háttér színeRögzítesz egy makrót, ahol megváltoztatod a karakter-, ill. a háttér színét. Onnan kimazsolázod azt, amire kiváncsi vagy.
Próba:For sor = 1 To 255
Cells(sor, 1).Select
Selection.Value = "Színkód=" & sor - 1
Selection.Font.ColorIndex = sor - 1
Cells(sor, 2).Select
Selection.Interior.ColorIndex = sor - 1
Next -
Delila_1
veterán
válasz
takyka77
#2997
üzenetére
Másold be az alábbi makrót. Minden nyitáskor az aktuális lapon zárolja az egy hetesnél régebbi sorokat, A-tól AD oszlopig. Ha több lapod van,a lapnév helyére írd be a védendő lapod nevét, ha csak egy, azt a sort töröld ki.
Sub auto_open()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Lapnév").Select
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor, 1) < Date - 6 Then
Range(Cells(sor, 1), Cells(sor, 30)).Select
Selection.Locked = True
End If
Next
ActiveSheet.Unprotect
End Sub -
Delila_1
veterán
válasz
Amazonas
#2989
üzenetére
Inputboxban kérdezem le a másolandó lap nevét, mert az havonta változni fog.
Sub masol()
lapnev = InputBox("Melyik a lezárt hónap?", "Adatátvitel az új hónap lapjára", Default)
Sheets(lapnev).Select
sor = 2: sor_uj = 2
Do While Cells(sor, 1) <> ""
If Cells(sor, 24) = "" Then
Range(Cells(sor, 1), Cells(sor, 23)).Select
Selection.Copy
ActiveSheet.Next.Select
Cells(sor_uj, 1).Select
ActiveSheet.Paste
sor_uj = sor_uj + 1
ActiveSheet.Previous.Select
End If
sor = sor + 1
Loop
End Sub -
Delila_1
veterán
válasz
Amazonas
#2982
üzenetére
Itt egy kis makró, ami a 0-val kezdődő sorokat kitörli. Ha megadod a két lapod nevét, és azt, hogy a januári lapon melyik oszlopban van az állapotot jelző adat, megírom az automatikus másolást.
Sub torles()
sor = 1
Do While Cells(sor, 1) <> ""
Cells(sor, 1).Select
If Cells(sor, 1) = 0 Then
Selection.EntireRow.Delete
Else
sor = sor + 1
End If
Loop
End Sub -
Delila_1
veterán
=INDIREKT(E2&"!"&G2&H2)+INDIREKT(F2&"!"&G2&H2)
ahol E2-ben van az első lapod neve (pl. '1)
F2-ben a második lap neve (pl. '2)
G2-ben az oszlop (pl. B)
H2-ben a sor (pl. 3)Az oszlop nevét idézőjelek között fixen is megadhatod, a sorét pedig anélkül, fixen.
=INDIREKT(E2&"!"&"B"&3)+INDIREKT(F2&"!"&"B"&3)
-
Delila_1
veterán
Itt megtalálod a personal.xls létrehozásának a menetét az 527-es hozzászólásnál.
Eszközök->Tools
Margókkal a fekvő lap:Sub Fekvo_lap()
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.393700787401575)
.CenterHorizontally = True
.Orientation = xlLandscape
End With
End SubAmi makrót a personalba teszel, az minden füzetnél elérhető lesz.
A fejléc és lábléc magasságát a HeaderMarginnál és a FooterMarginnál állíthatod. -
Delila_1
veterán
Még azt tehetnéd meg, hogy a personal.xls-be beviszed az alábbi makrót, és kiteszel hozzá egy ikont az eszköztárra. A fekvő lap beállításán kívül a táblázatodat vízszintesen a margók között középre is helyezi. Ha az nem kell, az alsó makrót használd.
Sub Fekvo_lap()
With ActiveSheet.PageSetup
.CenterHorizontally = True
.Orientation = xlLandscape
End With
End SubSub Fekvo_lap()
ActiveSheet.PageSetup.Orientation = xlLandscape
End Sub -
Delila_1
veterán
Én az eszköztárra tettem egy ikont, ami a kérdéses színeket megadja.
Sub Szín_lekérdezés()
If Selection.Font.ColorIndex = -4105 Then
MsgBox "A karakter színkódja: " & Selection.Font.ColorIndex & " (automatikus)"
Else
MsgBox "A karakter színkódja: " & Selection.Font.ColorIndex & " "
End If
If Selection.Interior.ColorIndex = -4142 Then
MsgBox "A cella hátterének színkódja: " & Selection.Interior.ColorIndex & " (átlátszó)"
Else
MsgBox "A cella hátterének színkódja: " & Selection.Interior.ColorIndex & " "
End If
End SubA subrutint a personal.xls-be tettem.
A két feltételt nem is kell belevenni, azok csak arra jók, hogy a -4105 és -4142-es színkódot könnyebben lehessen értelmezni.
Neked kétfelé kell vágnod a userformon ezt a rutint. -
Delila_1
veterán
válasz
VANESSZA1
#2928
üzenetére
C2-be (ez adja a munkahelyen eltöltött időt):
=B2-A2D2-be rafináltabb képlet kell (vagy a 8 óránál kevesebb időt, vagy 8-tól 8:30-ig 8 órát ad, vagy 8:30 fölött a teljes bent töltött időt adja):
=HA(VAGY(ÉS(C2>IDŐ(8;0;0);C2<IDŐ(8;31;0));C2>=IDŐ(8;30;0));IDŐ(8;0;0);C2)E2-be (a túlórát mutatja 8:30 fölött):
=HA(B2-A2>IDŐ(8;30;0);B2-A2-IDŐ(8;0;0);"")Ne feledkezz meg az ebédidőről, ha azt le kell vonni.
-
Delila_1
veterán
válasz
VANESSZA1
#2928
üzenetére
gsc válaszát kicsit tovább fejlesztve:
"A" oszlopban a belépés, "B"-ben a kilépés.C2-be: =ha(b2-a2>idő(8;30;0);idő(8;0;0);b2-a2)
D2-be: =ha(b2-a2>idő(8;30;0);b2-a2-idő(8;0;0);"")Mindegyik oszlop cellaformátuma idő, 37:30:55
Valószínű, hogy az ebédidőt is le kell vonni a teljes időből.
-
Delila_1
veterán
Másik megoldás a másoláson kívül, hogy hivatkozol a többi lap celláira.
Az első lap első üres oszlopába: =Sheet2!A1
Ezt vízszintesen, és függőlegesen is másolod addig, amíg az adatok kívánják.
Következő üres oszlopba =Sheet3!A1
és így tovább. A feleslegessé vált lapok törlése előtt az újonnan behozott adatokat másold, és ugyanoda irányítottan, értékként illeszd be (Insert menü).Lehet, hogy gyorsabb a Ctrl+C. Még hasznosabb is, mert ha a lapokon képletek, függvények szerepeltek, akkor azok a fenti módszerrel elvesznek.
-
#2893
Delila_1
veterán
DoubleLayer
#2892
Delila_1
veterán
válasz
DoubleLayer
#2892
üzenetére
Nem kellet volna egy óra. Az
=jobb(d12;hossz(d12)-5)megadta volna az irányítószám utáni részt.
Másik módszer:
=ha(közép(d2;6;8)="Budapest";valami;ellenkezője) -
#2890
Delila_1
veterán
DoubleLayer
#2889
Delila_1
veterán
válasz
DoubleLayer
#2889
üzenetére
Szétcincálás nélkül:
=HA(HIBÁS(SZÖVEG.TALÁL("Budapest";D12;1));"nem Budapest";"Budapest")
-
-
#2880
Delila_1
veterán
qpakcovboy
#2872
Delila_1
veterán
válasz
qpakcovboy
#2872
üzenetére
Régebben is segítettem neked, amire nem válaszoltál, ezt az utóbbi kérdést személyesen nekem tetted fel.
Elkészítettem amit kértél, elég sokat dolgoztam rajta.
Legkevesebb lenne, hogy közöld, nem felel meg a munkám az igényeidnek, vagy esetleg elrebegnél egy halk "köszönöm"-öt. -
#2877
Delila_1
veterán
qpakcovboy
#2876
Delila_1
veterán
válasz
qpakcovboy
#2876
üzenetére
OK
-
#2875
Delila_1
veterán
qpakcovboy
#2874
Delila_1
veterán
válasz
qpakcovboy
#2874
üzenetére
Skype-om van.
-
#2873
Delila_1
veterán
qpakcovboy
#2872
Delila_1
veterán
válasz
qpakcovboy
#2872
üzenetére
Küldd már el a fájlt e-mail-ben, mert nem nagyon értem.
-
Delila_1
veterán
Mondták, igaz, akkor istennőt mondtak. Köszönöm. Itt a javított kiadás hibakezeléssel.
Sub Adatok()
utvonal = "E:\Eadat\"
sor = 2
Do While Cells(sor, 1) <> ""
fnev = Cells(sor, 1) & ".xls"
funev = utvonal & Cells(sor, 1)
On Error GoTo hiba
Workbooks.Open Filename:=funev
If tal = 0 Then
ActiveWindow.ActivatePrevious
Cells(sor, 2).Select
ActiveCell.Formula = "=INDIRECT(""[" & fnev & "]Munka1!B3"")"
Cells(sor, 3).Select
ActiveCell.Formula = "=INDIRECT(""[" & fnev & "]Munka1!C6"")"
Cells(sor, 4).Select
ActiveCell.Formula = "=SUM(INDIRECT(""[" & fnev & "]Munka1!E1:E7""))"
Range(Cells(sor, 2), Cells(sor, 4)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.ActivateNext
ActiveWindow.Close
Else
Cells(sor, 2) = "Nem létező file"
End If
tal = 0
sor = sor + 1
Loop
Exit Sub
hiba:
Err = 0
tal = 1
Resume Next
End Sub -
Delila_1
veterán
-
Delila_1
veterán
Szia!
Ezt a makrót vidd be a teszt.xls-edbe:Sub Adatok()
utvonal = "E:\Eadat\"
sor = 2
Do While Cells(sor, 1) <> ""
fnev = Cells(sor, 1) & ".xls"
funev = utvonal & Cells(sor, 1)
Workbooks.Open Filename:=funev
ActiveWindow.ActivatePrevious
Cells(sor, 2).Select
ActiveCell.Formula = "=INDIRECT(""[" & fnev & "]Munka1!B3"")"
Cells(sor, 3).Select
ActiveCell.Formula = "=INDIRECT(""[" & fnev & "]Munka1!C6"")"
Cells(sor, 4).Select
ActiveCell.Formula = "=SUM(INDIRECT(""[" & fnev & "]Munka1!E1:E7""))"
Range(Cells(sor, 2), Cells(sor, 4)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.ActivateNext
ActiveWindow.Close
sor = sor + 1
Loop
End SubA 2. sorban az útvonalat írd át a saját útvonaladra, és ha a füzeteknek nem a Munka1 lapjáról kell beolvasni az adatokat, írd át mind a 3 helyen azt is az ActiveCell.Formula kezdetű sorokban. Jó munkát.
-
-
Delila_1
veterán
válasz
student
#2845
üzenetére
A súgóban keress rá az abszolút hivatkozásra.
"Az Excelben elvégzendő feladattól függően használhatunk relatív cellahivatkozást, amely a képlet helyzetéhez viszonyított cellahivatkozás, valamint abszolút hivatkozást, amely mindig adott helyen lévő cellákra történik. Ha egy betűt és/vagy számot dollárjel előz meg (például $A$1), az oszlop- és/vagy a cellahivatkozás abszolút. A relatív hivatkozás – ellentétben az abszolút hivatkozással – másoláskor automatikusan módosul."
-
Delila_1
veterán
-
Delila_1
veterán
válasz
Retekegér
#2833
üzenetére
Az FKERES függvény 1. paraméterébe a keresett értéket írjuk be. Ez nálad a 2007 lapon az A2.
2. paraméter: a tábla, amiben a keresést végrehajtjuk. Itt a 2008 lapon
$A$2:$B$50.
3. paraméter: a tábla hányadik oszlopában keresse az egyezőséget. Az elsőben.
4. pm: a keresés módját határozza meg. a HAMIS azt jelenti, hogy a pontosan egyező értéket keresse. A súgóban megtalálod a többi leírását.A képlet, melyet a 2007 lap C oszlopába írtunk, így szól:
=HA(HIBÁS(FKERES(A2;'2008'!A2:$B$50;1;HAMIS));"";FKERES(A2;'2008'!A2:$B$50;2;HAMIS))
A Ha függvény első pm-e a kritérium. Jelen esetben, ha HIBÁS az FKERES (nincs olyan érték a 2008-as lapon, mint az A2), akkor a 2. pm szerint üres stringet ("") ír a cellába.
A 3. pm azt írja, mit tegyen, ha nem igaz az első feltétel. Ebben az esetben nem igaz, hogy nem talált, vagyis talált megfelelő értéket. Ekkor beírja 2008-as lap táblázatának 2. oszlopában talált értéket.Biztosan le lehet írni érthetőbben is, tőlem ennyi telik. Írd be, másold végig, és meglátod, működni fog. A $50 helyett adj legalább akkora számot, ahány sorod van a 2008 lapon.
-
Delila_1
veterán
válasz
Retekegér
#2830
üzenetére
Az alábbi makró feltételezi, hogy a két lapod neve 2007, ill. 2008, valamint, hogy a termék neve mindkét lapon A2-ben, az ár B2-ben kezdődik.
Sub keres()
Sheets("2008").Select: Cells(1, 1).Select
Selection.End(xlDown).Select
sor_8a = Selection.Row
Sheets("2007").Select: Cells(1, 1).Select
Selection.End(xlDown).Select
sor_7a = Selection.Row
For sor_7 = 2 To sor_7a
termék = Cells(sor_7, 1)
For sor_8 = 2 To sor_8a
If Sheets("2008").Cells(sor_8, 1) = termék Then
Cells(sor_7, 3) = Sheets("2008").Cells(sor_8, 2)
End If
Next
Next
End SubMásold be, és futtasd.
-
#2808
Delila_1
veterán
toth_janika
#2807
Delila_1
veterán
válasz
toth_janika
#2807
üzenetére
Szívesen.
-
#2806
Delila_1
veterán
toth_janika
#2804
Delila_1
veterán
válasz
toth_janika
#2804
üzenetére
Az Y tengelynél a maximum 168, a lépték 16,8.
5").Select
Új hozzászólás Aktív témák
Fferi50- Milyen széket vegyek?
- Milyen videókártyát?
- Durván kitömte memóriával két új Radeonját az AMD
- iOS alkalmazások
- Formula-1
- Motorola Edge 50 Neo - az egyensúly gyengesége
- Békéscsaba és környéke adok-veszek-beszélgetek
- The Game Awards 2025 - Íme a nyertesek!
- Nyaralás topik
- LEGO klub
- További aktív témák...
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Keresem a Barkács Balázs Játékokat
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- BESZÁMÍTÁS! MSI B650 WIFI R7 7800X3D 32GB DDR5 1TB SSD RX 9070 XT 16GB Zalman Z1 PLUS GIGABYTE 750W
- HIBÁTLAN iPhone 15 Pro 128GB Black Titanium -1 ÉV GARANCIA -Kártyafüggetlen
- IKEA (HAVREHOJ) tablet tartó
- Telefon felvásárlás!! iPhone 11/iPhone 11 Pro/iPhone 11 Pro Max
- Bomba ár! HP ProBook 440 G5 - i5-8GEN I 8GB I 256GB SSD I HDMI I 14" FHD I Cam I W11 I Garancia!
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest