- Okosóra és okoskiegészítő topik
- Vivo X200 Pro - a kétszázát!
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Mobil flották
- Milyen GPS-t vegyek?
- Megjelent a Poco F7, eurós ára is van már
- CMF Buds Pro 2 - feltekerheted a hangerőt
- Apple iPhone 16 Pro - rutinvizsga
- Apple iPhone 15 Pro Max - Attack on Titan
- Huawei Watch Fit 3 - zöldalma
-
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
-
#49588
Delila_1
veterán
SwissAirplan
#49586
Delila_1
veterán
válasz
SwissAirplan
#49586
üzenetére
A G3 cella képlete legyen
=INDIREKT("B"&HOL.VAN(1000000;B:B)) -
#49562
Delila_1
veterán
MasterMark
#49561
Delila_1
veterán
válasz
MasterMark
#49561
üzenetére
A kulcs a táblázatkénti formázás.
Az első képlet beírása után az összes többi sorban is megjelenik a képlet, sorhelyesen.
Új sor bevitelekor ott is szerepel a képlet. -
#49556
Delila_1
veterán
MasterMark
#49555
Delila_1
veterán
válasz
MasterMark
#49555
üzenetére
Nem szükséges makró. Formázd az adataidat táblázatként.
Vegyük, hogy a B oszlopban számadatok vannak, az oszlop címe Összeg.
A következő (C) oszlopban a B oszlop értékeit fel akarod szorozni 3-mal.
A C2 képlete =[@Összeg]*3
Amint bővíted a táblázatodat, a C oszlop képlete automatikusan beíródik az új sorba. -
Delila_1
veterán
De igen, a szerző, Kovalcsik Géza tette elérhetővé.
Azt mondja, az újabb verziókhoz teljesen át kellene írnia a könyvet (reméljük, egyszer megteszi), ezért elérhetővé tette.
A könyvben írtak most is érvényesek, de az Excel újabb verziói sokkal több lehetőséget biztosítanak az újabb feladatokhoz.Sajnos az Összefoglaló szerkesztése le van tiltva, nem tudom betenni az újabb linket.
-
Delila_1
veterán
válasz
föccer
#49523
üzenetére
Makrós megoldást tudok, a ThisWorkbook laphoz kell rendelned. A G1 helyett azt a cellát add meg, ahova a felhasználó nevét szeretnéd biggyeszteni.
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim v
Set v = ActiveWorkbook.BuiltinDocumentProperties
ActiveSheet.Range("G1") = v(3)
End SubAz
ActiveSheet.Range("G1") = v(3)helyett megadhatod, hogy az élőfejben legyen a felhasználó neve, itt a jobb szélen.ActiveSheet.PageSetup.RightHeader = "Felhasználó: " & v(3) -
Delila_1
veterán
válasz
Delila_1
#49423
üzenetére
Hopsz, kimaradt az az eset, mikor mégis csak 1 kép nevét viszed be egyszerre.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FN As Picture, CV As Range, ter As Range
Dim KepHelye As String
If Target.Column = 1 Then
Application.EnableEvents = False
If Target.Count > 1 Then
Set ter = Range(Target.Address)
For Each CV In ter
KepHelye = "D:\kepek\" & CV.Value & ".jpg"
With Cells(CV.Row, 2)
Set FN = ActiveSheet.Pictures.Insert(KepHelye)
.RowHeight = Rows(Target.Row).Height
FN.Top = .Top + 1
FN.Left = Columns(2).Left + 1
FN.Height = Rows(Target.Row).Height - 5
FN.Height = .Height
FN.Placement = xlMoveAndSize
End With
Next
Else
KepHelye = "D:\kepek\" & Target.Value & ".jpg"
With Cells(Target.Row, 2)
Set FN = ActiveSheet.Pictures.Insert(KepHelye)
.RowHeight = Rows(Target.Row).Height
FN.Top = .Top + 1
FN.Left = Columns(2).Left + 1
FN.Height = Rows(Target.Row).Height - 5
FN.Height = .Height
FN.Placement = xlMoveAndSize
End With
End If
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
Private Sub Worksheet_Change(ByVal Target As Range)Dim FN As Picture, CV As Range, ter As RangeDim KepHelye As StringIf Target.Column = 1 ThenApplication.EnableEvents = FalseIf Target.Count > 1 ThenSet ter = Range(Target.Address)For Each CV In terKepHelye = "D:\kepek\" & CV.Value & ".jpg"With Cells(CV.Row, 2)Set FN = ActiveSheet.Pictures.Insert(KepHelye).RowHeight = Rows(Target.Row).HeightFN.Top = .Top + 1FN.Left = Columns(2).Left + 1FN.Height = Rows(Target.Row).Height - 5FN.Height = .HeightFN.Placement = xlMoveAndSizeEnd WithNextEnd IfApplication.EnableEvents = TrueEnd IfEnd Sub -
-
Delila_1
veterán
válasz
Zsolt_16
#49397
üzenetére
Minden lapon szűröd a feltöltő oszlopot Pisti-re. A szűrt tartományt kijelölöd, a státuszsorban látod a darabszámot.A kapott 18 értéket összeadod.
Ha ez a feladat ismétlődik, érdemes írni rá egy makrót, vagy kimutatást készíteni a lapokról, de 18 lapnál az egyszeri összeállítás nem nagy munka. -
Delila_1
veterán
A mindig látható munkalaphoz kell rendelned a makrót.
Nálam ezen a lapon a C2 cellába kell beírni a jelszót (itt EzAJelszó, de írd át kedved szerint a makróban) ahhoz, hogy a Munka2 lap látható legyen. A Munka2 nevét is átírhatod a makróban.Private Sub Worksheet_Change(ByVal Target As Range)If Target.Address = "$C$2" ThenIf Target = "EzAJelszó" Then Sheets("Munka2").Visible = -1 Else Sheets("Munka2").Visible = 2End IfEnd SubÉrdemes a ThisWorkbokk laphoz rendelni egy másik makrót, ami a füzet bezárásakor törli a Munka1 lap C2 cellájának a tartalmát.
Private Sub Workbook_BeforeClose(Cancel As Boolean)Sheets("Munka1").Range("C2") = ""End Sub -
Delila_1
veterán
válasz
Silious
#49380
üzenetére
Rendeld a lapodhoz (lásd Összefoglaló) a lenti makrót:
Private Sub Worksheet_Change(ByVal Target As Range)Dim FN As PictureDim KepHelye As StringIf Target.Column = 1 ThenKepHelye = "C:\kepek\" & Target & ".jpg"With Cells(Target.Row, 2)Set FN = ActiveSheet.Pictures.Insert(KepHelye).RowHeight = Rows(Target.Row).HeightFN.Top = .Top + 1FN.Left = Columns(2).Left + 1FN.Height = Rows(Target.Row).Height - 5FN.Height = .HeightFN.Placement = xlMoveAndSizeEnd WithEnd IfEnd Sub -
-
-
Delila_1
veterán
válasz
hentes555
#49331
üzenetére
A Letöltött lap A oszlopában vannak a rendszámok, az Adatok lapon a többi adat.
A Letöltött lap B2 cellájába beírod a képletet, jobbra másolod. majd mindkettőt le, ameddig adataid vannak az A oszlopban. Ha nincs meg a rendszám az Adatok lapon, a képlet HIÁNYZIK szöveget ad, pótolnod kell az Adatok lapon.
-
#49316
Delila_1
veterán
istvankeresz
#49314
Delila_1
veterán
válasz
istvankeresz
#49314
üzenetére
A C2 cella képlete legyen
=HA(SZÁM(A2);B1-A2;B1) -
#49299
Delila_1
veterán
istvankeresz
#49294
Delila_1
veterán
válasz
istvankeresz
#49294
üzenetére
A fejlécbe tegyél autoszűrőt, ezzel bármikor szűrheted az adataidat tetszőleges hónap szerint.
-
#49280
Delila_1
veterán
istvankeresz
#49279
Delila_1
veterán
válasz
istvankeresz
#49279
üzenetére
Szívesen.
-
#49278
Delila_1
veterán
istvankeresz
#49277
Delila_1
veterán
válasz
istvankeresz
#49277
üzenetére
A formátum jó, a képlet
=MA()-HÓNAP(MA()-1) -
#49217
Delila_1
veterán
dellfanboy
#49216
Delila_1
veterán
válasz
dellfanboy
#49216
üzenetére
NumLock billentyű vált a számok és a nyilak funkció között.
-
Delila_1
veterán
A másodikra a képlet
=HA((DARABTELI(A2:BH2;"T4")+DARABTELI(A2:BH2;"T8"))<2;HAMIS;IGAZ)Az elsőre a BI2-be, vagy BK2-be
=HA((DARAB2(A2:BH2)-DARABTELI(A2:BH2;"DE")-DARABTELI(A2:BH2;"DU")-DARABTELI(A2:BH2;"P")-DARABTELI(A2:BH2;"B")-DARABTELI(A2:BH2;"ÉJ")-DARABTELI(A2:BH2;"T4")-DARABTELI(A2:BH2;"T8"))>0;HAMIS;IGAZ)detroitrw (49198): szívesen.
-
Delila_1
veterán
Az előzőnél az
oszlop = Application.Match(cim, Range("G1:BB1"), 0)
sor olykor 0 értéket ad, ha nem található a G1 : BB1 tartományban a cím.
Az eredetiIf VarType(oszlop) = vbError Then
sort ezért kibővítettemIf VarType(oszlop) = vbError Or oszlop=0 Then
-re, de lemaradt egy p betű az oszlop végéről. -
Delila_1
veterán
Sub Masolas()Dim cim As String, sor As Long, tartomany As Range, oszlop As Integer, usor As LongSet tartomany = Selectionsor = tartomany(1).Rowcim = Cells(sor, 2)On Error Resume Nextoszlop = Application.Match(cim, Range("G1:BB1"), 0)If VarType(oszlop) = vbError Or oszlo=0 Thenoszlop = Cells(1, Columns.Count).End(xlToLeft).Column + 1Cells(1, oszlop) = cimElseoszlop = oszlop + 6End Ifusor = Cells(Rows.Count, oszlop).End(xlUp).Row + 1Selection.Copy Cells(usor, oszlop)End Sub -
#49132
Delila_1
veterán
aprokaroka87
#49128
Delila_1
veterán
válasz
aprokaroka87
#49128
üzenetére
Excelben a cellaformátum
;;;@" mm" -
-
-
Delila_1
veterán
válasz
andreas49
#49098
üzenetére
Sub AblakRogzites()Dim lap As IntegerApplication.ScreenUpdating = FalseFor lap = 1 To Worksheets.CountSheets(lap).SelectRange("B2").Select 'Itt írd át a rögzítés helyétActiveWindow.FreezePanes = TrueNextApplication.ScreenUpdating = TrueEnd SubEz a makró minden lapon rögzíti az ablaktáblát B2-ben. Az első sor és első oszlop nem mozdul el görgetéskor. A B2 helyét átírhatod az igényednek megfelelően.
-
#49031
Delila_1
veterán
Fire/SOUL/CD
#49029
Delila_1
veterán
válasz
Fire/SOUL/CD
#49029
üzenetére
Egy harmadik megoldás
=HA(A1=INT(A1);0;KÖZÉP(A1;SZÖVEG.KERES(",";A1)+1;15)) -
Delila_1
veterán
Ha A1-ben van a szóközt tartalmazó számod, ezzel a képlettel az új oszlopban számot kapsz, amit majd értékként az eredeti helyére másolhatsz.
Egyszerre is számmá alakíthatod mindet, és még segédoszlop sem kell.
Beírsz egy üres cellába egy egyest, másolod Ctrl+c-vel, kijelölöd a szóközös tartományt, majd irányított beillesztés, ahol bejelölöd a szorzást. -
Delila_1
veterán
válasz
Salex1
#48989
üzenetére
A belinkelt képen a szétválasztandó adatok a D oszlopban voltak, eszerint írtam meg a makrót. Nem véletlenül került be az Összefoglalóba, hogy
– Ne azt írd, hogy például az A oszlop szűrt adatait szeretnéd a C oszlopba másolni, ha valójában a B oszlop szűrt adatai kellenek egy másik lap X oszlopába.
Ha nem eszerint jársz el, dupla munkát okozol annak, aki szívességet tesz neked.
Most sem pontos a kérésed. Nem szerepel benne, hogy a kép szerinti A-B-C és E oszlopok adatai hol szerepelnek a lapodon. -
Delila_1
veterán
Írtam én is egy makrót – sok magyarázattal –, ami létrehozza a tartalomjegyzék lapot, és az egyes lapokra a visszaugrás csatolást.
Sub Tartalomjegyzek()'A makró egy tetszőleges nevű munkalapot szúr be a meglévők elé.'Erre a munkalapra egy tartalomjegyzéket készít a többi munkalapot listázva,'hivatkozást is elhelyezve, amik az egyes munkalapok egy megadott cellájára mutatnak.'A lapokra vissza logikájú linket helyez el kérésre, egy megadott cellába.Dim TartalomLapnev As String, VisszaSzovege As String, VisszaHelyeDim aktiv As Integer, Vissza As Integer'Megkérdezi a felhasználótól, mi legyen a tartalomjegyzék munkalapjának a neveTartalomLapnev = InputBox("Mi legyen a tartalomjegyzék munkalapjának neve?", "Tartalomjegyzék munkalapjának neve")'Megkérdezi, szeretnénk-e vissza gombot elhelyezni a munkalapokon?Vissza = MsgBox("Legyen-e egy vissza logikájú link a munkalapokon?", 4, "Vissza logikájú link")'Ha igen, kérdezze meg, mi legyen a szöveg? pl. 0171:«'és hol legyen az egyes lapokonIf Vissza = 6 ThenVisszaHelye = InputBox("Hova kerüljön a vissza logikájú link a lapokon?" & vbLf & "Pl.: A1", "Vissza logikájú link helye")VisszaSzovege = InputBox("Mi legyen a vissza logikájú link felirata?" & vbLf & "Pl. « (bal Alt+0171), vagy Vissza", "Vissza logikájú link felirata")End If'Szúrjon be egy új munkalapot a meglévők elé a legelső helyre.ActiveWorkbook.Sheets.Add Before:=Worksheets(1)'Adja az új munkalapnak a felhasználó által megadott nevetWorksheets(1).Name = TartalomLapnevRange("B1") = TartalomLapnevRange("B1").Font.Size = 14'Menjen végig a munkalapokon ...For aktiv = 2 To ActiveWorkbook.Sheets.Count'Írjon sorszámot.Worksheets(1).Cells(aktiv, 1).Value = aktiv - 1 'sorszám'Adjon linket a lapokhozWith Worksheets(1).Hyperlinks.Add Anchor:=.Cells(aktiv, 2), Address:="", _SubAddress:="'" & Worksheets(aktiv).Name & "'!" & VisszaHelye, TextToDisplay:=Worksheets(aktiv).NameEnd With'Ha kértünk Vissza linket, hozza létre a vissza logikájú linket a megadott cellábaIf Vissza = 6 ThenWith Worksheets(aktiv) 'itt adjuk meg, hogy a Vissza link melyik cellára álljon az első lapon.Hyperlinks.Add Anchor:=.Range(VisszaHelye), Address:="", _SubAddress:="'" & TartalomLapnev & "'!B" & aktiv, TextToDisplay:=VisszaSzovege.Range(VisszaHelye).Font.Bold = TrueEnd WithEnd IfNext aktivEnd Sub -
Delila_1
veterán
-
-
-
Delila_1
veterán
válasz
MCMLXXXII
#48956
üzenetére
Egyszerű válasz: nem.
Egy makrós megoldás lehet a célkereszt .
Még egyszerűbb, de szintén makrós megoldás: a laphoz rendelt makró
Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Application.CutCopyMode = False Then Application.CalculateEnd Sub
A feltételes formázás képlete pedig=VAGY(CELLA("sor")=SOR();CELLA("Oszlop")=OSZLOP()) -
#48873
Delila_1
veterán
Lasersailing
#48871
Delila_1
veterán
válasz
Lasersailing
#48871
üzenetére
Beírod a szöveget egy alakzatba. A fájl indításakor láthatatlanná teszed.
Láthatóvá teszed, indítod az adatkiírást, elrejted az alakzatot.Sheets(1).Shapes.Range("Alakzat").Visible = True'adatkiírásSheets(1).Shapes.Range("Alakzat").Visible = False -
Delila_1
veterán
válasz
Salex1
#48857
üzenetére
A mintád alapján írtam egy makrót, ami a Munka2 lapra írja az első kép adatait a második képed szerint . A makrót modulba másold, a füzetet makróbarátként kell elmentened.
Sub Atrendez()Dim oszlop As Integer, uoszlop As Integer, ide As Long, sor, usor As LongRange("V:BB").ClearContentsSheets("Munka2").Range("A:E").ClearContentsusor = Range("E" & Rows.Count).End(xlUp).RowRange("D1:D" & usor).Copy Range("V1")With Range("V1:V" & usor).Replace What:="W", Replacement:=",0".Replace What:=",0", Replacement:="W".Replace What:="[", Replacement:="".Replace What:="]", Replacement:="".Replace What:="'", Replacement:="".TextToColumns Destination:=Range("V1"), Comma:=TrueEnd WithRange("V1", ActiveCell.SpecialCells(xlLastCell)).SelectSelection.Replace What:="W", Replacement:=",0"Cells(1).Selectide = 1For sor = 1 To usoruoszlop = Cells(sor, Columns.Count).End(xlToLeft).ColumnWith Sheets("Munka2")For oszlop = 22 To uoszlopRange("A" & sor & ":C" & sor).Copy .Range("A" & ide).Range("D" & ide) = Cells(sor, oszlop).Range("E" & ide) = Cells(sor, "E")ide = ide + 1NextEnd WithNextRange("V:BB").ClearContentsSheets("Munka2").SelectCells(1).SelectEnd Sub -
#48837
Delila_1
veterán
Fire/SOUL/CD
#48836
Delila_1
veterán
válasz
Fire/SOUL/CD
#48836
üzenetére
Az a nagy kérdés, hogy hány magyar 9 betűs szó van, és az honnan tölthető le.
-
#48835
Delila_1
veterán
Fire/SOUL/CD
#48834
Delila_1
veterán
válasz
Fire/SOUL/CD
#48834
üzenetére
Mihez?
-
Delila_1
veterán
válasz
dave0825
#48828
üzenetére
Szia!
Szerintem ezt csak makróval lehet megoldani, de akkor sem biztos, hogy értelmes szót tudsz kihozni az A1:I1 tartományban megadott betűkből.
A3-tól kezdve lefelé íródnak be a "szavak".
A két makrót másold be egy modulba. A csillagokkal jelölt sorban írd át a 15-öt nagyobbra, ha több, vagy kevesebb szót akarsz kihozni.
A Veletlen makrót kell indítanod.Sub Veletlen()Dim oszlop As Integer, sor As IntegerRange("A3:A100") = ""Range("N2:V2").FormulaR1C1 = "=COUNTIF(R1C14:R1C22,R[-1]C)"For sor = 3 To 15 '******** a 15-öt írd átRandomFor oszlop = 14 To 22If Cells(2, oszlop) > 1 Thenoszlop = 0: RandomEnd IfNextRange("N1:V1").CopyRange("N1").PasteSpecial xlPasteValuesFor oszlop = 14 To 22Range("A" & sor) = Range("A" & sor) & Cells(1, Cells(1, oszlop))NextNextRange("N1:V2") = ""Cells(1).SelectApplication.CutCopyMode = FalseEnd SubSub Random()Range("N1:V1") = "=RANDBETWEEN(1,9)"End Sub -
Delila_1
veterán
válasz
Anulu79
#48751
üzenetére
Alt+F11-gyel belépsz a VB szerkesztőbe. Bal oldalon kiválasztod a füzetedet, és azon belül a lapodat.
Ha nem látszik a Proporties ablak, F4.gyel megjeleníted, és beállítod a ScollArea értéket.
Megadhatod pl. $A$1:$G$100 módon is, akkor a G oszlopon túlra nem lehet gördíteni.
-
Delila_1
veterán
válasz
andreas49
#48559
üzenetére
Másold be a makrót egy modulba az Összefoglaló szerint.
Sub Sorbeszuras()Dim sor As Long, usor As Long, lepeskoz As Integerlepeskoz = Application.InputBox("Hány üres sor legyen az adatok között?", "Üres sorok száma", , , , , , 1)usor = Range("A" & Rows.Count).End(xlUp).RowFor sor = usor To 3 Step -1Rows(sor & ":" & sor + lepeskoz - 1).Insert Shift:=xlDownNextEnd Sub -
#48508
Delila_1
veterán
Fire/SOUL/CD
#48501
Delila_1
veterán
válasz
Fire/SOUL/CD
#48501
üzenetére
Hihetetlen, mire nem vetemedsz!
-
Delila_1
veterán
válasz
Nixon18
#48495
üzenetére
Valamikor régen már feltettem a makrót – talán többször is – de most nem találom. Újra felteszem.
Function Szam_kiiras(szam As Long) As StringDim j1, j10, j10a, j100j1 = Array("", "egy", "kettő", "három", "négy", "öt", "hat", "hét", "nyolc", "kilenc")j10 = Array("", "tíz", "húsz", "harminc", "negyven", "ötven", "hatvan", "hetven", "nyolcvan", "kilencven")j10a = Array("", "tizen", "huszon", "harminc", "negyven", "ötven", "hatvan", "hetven", "nyolcvan", "kilencven")j100 = Array("száz", "", "ezer", "millió", "milliárd")betu = ""If szam = 0 ThenSzam_kiiras = "Nulla"Exit FunctionEnd Ifs = Format(szam, "0")j = 1While s <> ""i = Len(s) - 2If i < 1 Then i = 1s2 = Mid(s, i, 3)s = Left(s, i - 1)s3 = ""If Len(s2) = 3 Thens3 = s3 + j1(Asc(Mid(s2, 1, 1)) - 48)If Mid(s2, 1, 1) <> "0" Then s3 = s3 + j100(0)s2 = Right(s2, Len(s2) - 1)End IfIf Len(s2) = 2 ThenIf Mid(s2, 2, 1) = "0" Thens3 = s3 + j10(Asc(Mid(s2, 1, 1)) - 48)Elses3 = s3 + j10a(Asc(Mid(s2, 1, 1)) - 48)End Ifs2 = Right(s2, Len(s2) - 1)End Ifs3 = s3 + j1(Asc(Mid(s2, 1, 1)) - 48)If s3 <> "" Then s3 = s3 + j100(j)If (betu <> "") And (szam > 2000) And (s3 <> "") Then kot = "-" Else kot = ""betu = s3 + kot + betuj = j + 1Wendbetu = UCase(Left(betu, 1)) & Right(betu, Len(betu) - 1)Szam_kiiras = betuEnd Function
Új hozzászólás Aktív témák
Hirdetés
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- Gyermek PC játékok
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Xiaomi Redmi A3 128GB, Kártyafüggetlen, 1 Év Garanciával
- Telefon felvásárlás!! Samsung Galaxy A13/Samsung Galaxy A33/Samsung Galaxy A53
- Iphone 15 Plus 128GB Pink Dobozos 12 Hónap Garancia
- Xiaomi 15 Ultra 512GB, Kártyafüggetlen, 1 Év Garanciával
- AKCIÓ! 16GB (2x8) G.Skill Trident Z RGB 4266MHz DDR4 memória garanciával hibátlan működéssel
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest