- Telekom mobilszolgáltatások
- Milyen okostelefont vegyek?
- Huawei Watch 4 Pro - kívül-belül domborít
- One mobilszolgáltatások
- Milyen GPS-t vegyek?
- Fotók, videók mobillal
- Apple Watch
- Bemutatkozott a Poco X7 és X7 Pro
- Csak semmi szimmetria: flegma dizájnnal készül a Nothing Phone (3)
- Google Pixel 9a - a lapos munka
-
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
válasz
torment #12026 üzenetére
Perfag makrójába írtam be a
lap = "gép" & Range("X15") & "_heti" sort, és a másolásnál a lap helyét ennek megfelelően módosítottam.Sub Másol()
Sheets("Lemez_Spc").Select
Dim lap As String, sor As Integer, oszlop As Integer
lap = "gép" & Range("X15") & "_heti"
sor = Range("Y21")
oszlop = Range("Y6")
Range("B35:F42").Copy Sheets(lap).Range("B3").Offset((sor - 1) * 8, (oszlop - 1) * 5)
End Sub -
Delila_1
veterán
válasz
erich85T #12018 üzenetére
A makró egy irányított szűréssel indul, ami az A oszlopban lévő neveket szűri meg úgy, hogy minden név csak egyszer szerepeljen az E oszlopban. Ezután a nevek mellé felsorolja az adatokat.
Sub mm()
Dim sor As Integer, usor As Integer, sor_név As Integer, usor_név As Integer
Dim név, oszlop As Integer
'Irányított szűrés az E oszlopba az egyedi nevekkel
Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"E1"), Unique:=True
usor = Range("E1").End(xlDown).Row: usor_név = Range("A1").End(xlDown).Row
'Kigyűjtés
For sor = 2 To usor
név = Cells(sor, "E"): oszlop = 6
For sor_név = 2 To usor_név
If Cells(sor_név, 1) = név Then
Cells(sor, oszlop) = Cells(sor_név, 2)
oszlop = oszlop + 1
End If
Next
Next
End Sub -
Delila_1
veterán
válasz
torment #12014 üzenetére
Nem offset-tel oldottam meg, hanem a több elágazású select case-zel.
A Select Case sorban meg kell adni a figyelendő változót, a Case1, Case2, ....Case7 sorokban pedig azt, hogy melyik érték esetén mit csináljon a program.
Sub Másol()
Dim sor%, oszlop%
Sheets("Lemez_Spc").Select
sor% = Range("Y21"): oszlop% = Range("Y6")
Select Case sor%
Case 1
sor% = 3
Case 2
sor% = 11
Case 3
sor% = 19
End Select
Select Case oszlop%
Case 1
oszlop% = 2
Case 2
oszlop% = 7
Case 3
oszlop% = 12
Case 4
oszlop% = 17
Case 5
oszlop% = 22
Case 6
oszlop% = 27
Case 7
oszlop% = 32
End Select
Range("B35:F42").Copy Sheets("Heti_adatbázis").Cells(sor%, oszlop%)
End SubSzerk:
A #12012-es hozzászólásban úgy látszik, mintha 2 sorban lenne megadva a honnan - hova másol, pedig 1 sorba kell írni, közötte szóközzel. Programkódként kellett volna megadnom. -
Delila_1
veterán
válasz
torment #12009 üzenetére
Addig is, míg Perfag kérdéseire válaszolsz, a másolás egyszerűbb módja
sheets("Lemez_SPC").range("B35:F42").copy sheets("Heti_adatbázis").range("B3")
elegendő.
Ahhoz, hogy ne legyen mindenféle vigyori fej a képletben, ki kell jelölnöd, és a "Konvertálatlan" üzemmódot kell alkalmaznod. -
Delila_1
veterán
válasz
Apollo17hu #11995 üzenetére
Nem kell semmit összefűznöd.
A D oszlopnak ezt a formátumot add az egyéni kategóriában:
éééé.hh.nn - nnnn -
Delila_1
veterán
válasz
Apollo17hu #11993 üzenetére
Részemről szívesen.
-
Delila_1
veterán
válasz
Apollo17hu #11990 üzenetére
A Worksheet_Change tip. esemény kezelés a bevitelt figyeli.
A Set ter = Intersect(Target, Range("C2:C300")) sor megadja a figyelendő területet. Ha ezen a területen belül adsz új értéket egy cellának, a bevitt érték sorában (Target.Row) a 4. oszlopba beviszi az aktuális dátumot.Private Sub Worksheet_Change(ByVal Target As Range)
Dim ter As Range
Set ter = Intersect(Target, Range("C2:C300"))
If Not ter Is Nothing Then Cells(Target.Row, 4) = Date
End Sub -
Delila_1
veterán
válasz
Apollo17hu #11987 üzenetére
A makrót a laphoz kell rendelned, aminek a módjára elég sok példát találsz itt a fórumon.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then Range("A2") = Date
If Target.Address = "$B$1" Then Range("B2") = Now
End SubA makró első sora a dátumot írja be az A2-be, mikor az A1-be beírtál valamit. A második sor a B1 kiállításakor az időt írja a B2-be. Tetszésed szerint írd át és alkalmazd.
-
Delila_1
veterán
Régebbi verzióban a Szerkesztés - Csatolások menüpontban a Váltás gomb segítségével kitallózod az aktuális fájlt. Gyakorlatilag a csatolás saját magára mutat majd minden füzetben. Ezzel a lépéssel egyszerre minden lapon megszűnik a másik füzetre történő hivatkozás.
Másik, kicsit macerásabb mód, hogy a csere funkció segítségével a hivatkozásnak azt a részét, ami a másik füzetre mutat, minden egyes lapon lecserélsz "semmire" (üresen hagyod a mire cserél rovatot).
-
Delila_1
veterán
válasz
Faterkam #11967 üzenetére
A kigyűjtő lap A oszlopába írod a 12 (? először ennyit írtál, most 20-at) várost.
B1-be: =DARABTELI(Munka1!BF:BF;A1) kerül, ahol a Munka1 helyére annak a lapnak a nevét írod, amelyik a 2000 sort tartalmazza.
Az egyéb helységeket meg kiszámolod.
Az első lapra teszel egy képletet: =darab2(BF:BF)
Ebből kivonod a második lap B oszlopának a szummáját. -
Delila_1
veterán
-
Delila_1
veterán
válasz
Sir Pocok #11947 üzenetére
Szívesen.
Na és melyik verziót használod? Mindig azzal kezdd a kérdést! Lehet, hogy a többi válaszadónak elég, ha egyszer beírod, nekem nem.
Már a felhasználói lapodat is megnéztem remélve, hogy nem az én lakhelyemen van ez a csodás üzlet a 60 napja lejárt szavatosságú tejfellel.
-
Delila_1
veterán
válasz
Sir Pocok #11943 üzenetére
A függvény attól függ, melyik verziót használod.
2007-es és 2010-es verzióban a D2 képlete (címsort feltételezve)
=SZUMHATÖBB(C:C;A:A;A2;B:B;"<="&MA()-60)Régebbi verziókban
=SZORZATÖSSZEG((A2:A1000=A2)*(B2:B1000<=MA()-60);C2:C1000)Az utóbbinál a tartományok utolsó sorát 1000-ről írd át a saját utolsó sorodra. Írhatsz jóval nagyobb számot is.
Akkor még eladjátok, ha csak 50 napja járt le a szavatossága?!
-
Delila_1
veterán
Nem a sok kérdéssel van baj, hanem azzal, hogy nem gondoltad át a kérdés feltevése előtt, mit is szeretnél elérni.
Először a lapok teljes utolsó oszlopának a másolását kérted, utána egy-egy meghatározott tartományét más helyre, végül azt, hogy ezek értékét vigyük be az új füzetbe. Az utolsó verziót már az első alkalommal is tudhattad.
Nyugodtan tedd fel a más témára vonatkozó további kérdéseidet.
-
Delila_1
veterán
Jó, hogy így apránként csepegteted az óhajokat, nem hagysz ellustulni.
Az új kívánságaid alkalmával mindig létre kell hoznom 3 füzetet, különböző lapszámmal, és különböző adatokkal a makró próbájához.Sub Osszevon_()
Const utvonal = "E:\Eadat\Excel fórumok\Próba\"
Dim FN As String, WB As Workbook, WBGy As Workbook
Dim lap As Integer, oszlop As Integer, oszlop_gy As Integer
Application.ScreenUpdating = False
oszlop_gy = 3
Set WBGy = Workbooks("Gyűjtő_FrostyBoy84.xls")
ChDir utvonal
FN = Dir(utvonal & "*.xls", vbNormal)
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=FN
For lap = 1 To Worksheets.Count
Sheets(lap).Select
Range("H28:H80").Copy
ActiveWindow.ActivatePrevious
Cells(9, oszlop_gy).Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveWindow.ActivateNext
oszlop_gy = oszlop_gy + 1
Next
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
Application.ScreenUpdating = True
End SubBugizozi
Lehet, hogy a képletek külső hivatkozásokat tartalmaznak, új füzetbe való másoláskor felborulnak. -
Delila_1
veterán
Sub Osszevon()
Const utvonal = "E:\Eadat\Excel fórumok\Próba\" 'Itt írd át az útvonalat
Dim FN As String, WB As Workbook, WBGy As Workbook
Dim lap As Integer, oszlop As Integer, oszlop_gy As Integer
oszlop_gy = 3
Set WBGy = Workbooks("Gyűjtő.xls") 'Itt írd át a gyűjtő füzeted nevét
ChDir utvonal
FN = Dir(utvonal & "*.xls", vbNormal)
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=FN
For lap = 1 To Worksheets.Count
Sheets(lap).Select
Range("H28:H80").Copy WBGy.Sheets(1).Cells(9, oszlop_gy)
oszlop_gy = oszlop_gy + 1
Next
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
End Sub -
Delila_1
veterán
Az lehet a baj, hogy a lapokon az első sorban nincs adat. Az
oszlop = Cells(1, Columns.Count).End(xlToLeft).Column
sorban a kiemelt 1-es adja, hogy az első sorba írt adatok alapján nézze meg a makró, melyik az utolsó oszlop. Ezt a számot írd át akkorára, ahol már biztosan van minden lapodon adat.
-
Delila_1
veterán
Kicsit zavarod a fogalmakat. Az Excelben egy fájl (akármi.xls) egy munkafüzet, amiben több lap lehet. Alapállásban 3 lap szokott lenni egy füzetben (fájlban).
A raktár nevű lap C2 cellájába írd be a képletet:
=HA(INDIREKT("eladás!B" & HOL.VAN(A2;eladás!A:A;0))=B2;"igen";"nem")
Azért a 2. sorba, mert feltételezem, hogy az első a címsor.
A képletet tartalmazó cellán állva a jobb alsó sarkán látsz egy kis fekete négyzetet. Erre duplán klikkelve lemásolódik a képlet a többi sorba, ameddig értékeket talál a B oszlopban.
-
Delila_1
veterán
Adatok, Rendezés és szűrés, Speciális.
Itt megadhatod, hogy más helyre másolja. A listatartomány az oszlopod. Szűrőtartományt nem kell megadnod, a Hova másolja rovatba azt a cellát írd, ahol el akarod kezdetni a kigyűjtést. Tegyél pipát a Csak az egyedi rekordok megjelenítése nevű négyszögbe.
-
Delila_1
veterán
Az útvonalat, és a füzet nevét kell átírnod.
Sub Osszevon()
Const utvonal = "E:\Eadat\Excel fórumok\Próba\" 'Itt írd át az útvonalat
Dim FN As String, WB As Workbook, WBGy As Workbook
Dim lap As Integer, oszlop As Integer, oszlop_gy As Integer
oszlop_gy = 1
Set WBGy = Workbooks("Gyűjtő.xls") 'Itt írd át a gyűjtő füzeted nevét
ChDir utvonal
FN = Dir(utvonal & "*.xls", vbNormal)
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=FN
For lap = 1 To Worksheets.Count
Sheets(lap).Select
oszlop = Cells(1, Columns.Count).End(xlToLeft).Column
Columns(oszlop).Copy WBGy.Sheets(1).Cells(1, oszlop_gy)
oszlop_gy = oszlop_gy + 1
Next
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
End Sub -
Delila_1
veterán
válasz
bugizozi #11868 üzenetére
Sok rövidítéshez.
A K oszlopban legyenek a rövidítések, az L-ben a hozzájuk tartozó számok, nullától felfelé.
A nullához a "Nincs rövidítés a sorban" szöveg – vagy valami elfogadhatóbb – tartozzon a K oszlopban.Function akármi(ter As Range)
Dim b As Integer, CV
b = 0
For Each CV In ter
If CV > "" Then
If Application.WorksheetFunction.VLookup(CV, Columns("K:L"), 2, 0) > b Then
b = Application.WorksheetFunction.VLookup(CV, Columns("K:L"), 2, 0)
End If
End If
Next
akármi = Range("K" & Application.WorksheetFunction.Match(b, Columns("L:L"), 0))
End Function -
Delila_1
veterán
válasz
m.zmrzlina #11852 üzenetére
A 2003 is ismeri a RANDBETWEEN függvényt, a 2010-ben VÉLETLEN.KÖZÖTT a neve.
-
Delila_1
veterán
A B1 cellában a megadott útvonal ilyen C:\Főkönyvtár\Alkönyvtár\AlAlkönyvtár\ legyen. Ne maradjon le a végéről a "\".
Sub SokPld()
Dim lap%, ment As String
Application.ScreenUpdating = False
For lap% = 1 To 100
Sheets(lap%).Select
ment = Cells(2) & Cells(1) & ".xls"
Sheets(lap%).Copy
ActiveWorkbook.SaveAs Filename:=ment, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
Next
Application.ScreenUpdating = True
End Sub -
-
Delila_1
veterán
Írtam, hogy a kimutatás az összes eladott gyógyszer (fajtánkénti) árát hozza. Lehet, hogy idén egyes gyógyszerekből kevesebbet vettek, ezért az idei összes eladási áruk kevesebbre jön ki, mint a tavalyi, még akkor is, ha az a bizonyos orvosság éppen drágább lett. Talán éppen azért vettek belőle kevesebbet.
-
Delila_1
veterán
A J oszlopban "nem"-re szűrsz. Kijelölöd az összes sort, és törlöd. Előtte készíts egy másolatot a lapról.
A kigyomlált sorokról érdemes egy speciális szűrést készíteni. Adatok - Rendezés és szűrés - Speciális.
Az összegeket a G oszlopba írtam, azért van ez a kijelölés. Az L1:N... helyre kerülnek az adatok. Ezt a tartományt rendezed a megnevezés, majd az év szerint. Minden gyógyszered 2 értéke egymás alatt lesz, amivel már könnyen számolhatsz egy HA függvénnyel.
-
Delila_1
veterán
Mondok egy egyszerűbbet. Készíts kimutatást, amibe a H-t, I-t, és azt az oszlopot veszed be, amelyik az árat tartalmazza.
A sorcímkébe húzod a megnevezést, az oszlopcímkébe az évet, az értékekhez az árat.
Ezzel 1 sorba kerül minden termék neve mellé a 2 évi ára.
A kimutatás következő oszlopába betehetsz egy HA függvényt, ami kiírja az eredményt.=HA(C5>B5;"drágult";"olcsóbb lett")
Szerk.: Ez hülyeség volt, hagyd figyelmen kívül!
-
Delila_1
veterán
A laphoz rendelt makróval lehet megoldani. Az első változatot írtam meg, mikor az A1-be írva a B1 zárolt lesz. Mikor törlöd az A1 tartalmát, mindkét cella felszabadul. A B1-be írva az A1 lesz zárolt.
A makró indítása előtt a többi cellában – ahova még akarsz írni a fenti kettőt kivéve – töröld a zárolást.
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect UserInterfaceOnly:=True
If Not Intersect(Target, Range("A1:B1")) Is Nothing Then
If IsEmpty(Target) Then
Range("A1:B1").Locked = False
Exit Sub
End If
End If
If Target.Address = "$A$1" Then
Range("B1").Locked = True: Range("A1").Locked = False
End If
If Target.Address = "$B$1" Then
Range("A1").Locked = True: Range("B1").Locked = False
End If
End Sub -
Delila_1
veterán
válasz
atillaahun #11802 üzenetére
Nem olvastam vissza, de feltételezem, hogy makró is van a füzetedben. Az
Application.DisplayAlerts=False
sor letiltja a kérdést. Érdemes óvatosan bánni vele, sokszor hasznos a rákérdezés.
-
Delila_1
veterán
válasz
Pulsar #11747 üzenetére
A fájl útvonalát és nevét csak akkor kell beírni a képletbe, ha a képletet tartalmazó, és a keresendő tartományok nem azonos fájlban vannak.
A kereső lap D4 cellájába írtam a képletedet a füzet megnevezése nélkül. Még annyit rövidítettem rajta, hogy a HAMIS helyett mindenhol nullát írtam.
=HA(HIBÁS(FKERES(AA4;'Line 8'!$A$4:$T$1700;4;0));HA(HIBÁS(FKERES(AA4;'Line 9'!$A$4:$T$1700;4;0));FKERES(AA4;'Line 11'!$A$4:$T$1700;4;0);FKERES(AA4;'Line 9'!$A$4:$T$1700;4;0));FKERES(AA4;'Line 8'!$A$4:$T$1700;4;0))Az E4 képlete
=HA(HIBÁS(FKERES(AA4;'Line 8'!$A$4:$T$1700;4;HAMIS));HA(HIBÁS(FKERES(AA4;'Line 9'!$A$4:$T$1700;4;HAMIS));"Line 11";"Line 9"))Abban az esetben, ha a Line 8 lapon van találat, ennek a képletnek az értéke (kimenete) HAMIS lesz. Hagyhatnánk így is, mivel tudod, hogy az E oszlop HAMIS értékénél a Line 8 lapon talált a keresésnek megfelelő adatot, de beírhatunk az F oszlopba egy új képletet:
=HA(BAL(E4;4)<>"Line";"Line 8";E4)
ami a Line 8-at is kiírja.Lehet, hogy van egyszerűbb megoldás, biztosan jelentkezik vele valaki.
-
Delila_1
veterán
válasz
Pulsar #11741 üzenetére
A Cella("filename") függvény megadja a fájl teljes elérési útvonalát, a fájlnevet, és a lapnevet. Ebből szövegfüggvényekkel ki tudod keresni a lapnevet.
=JOBB(A1;HOSSZ(A1)-SZÖVEG.TALÁL("]";A1))
A hosszú, vidám (HA-HA-HA) függvényedbe beépítve egy segédoszlopban kiírathatod.
-
Delila_1
veterán
Az első képen szándékosan 2 féle módon hivatkoztam a megyét tartalmazó A oszlopra. B28-ban az INDEX, B30-ban az INDIREKT függvénnyel.
A második képre beillesztettem az A oszlop szűrésének a képét. Mivel az egyéni kategóriában csak 2 szempont szerint lehet szűrni, felvettem egy új oszlopot (G), és a 3. szempont szerinti szűrést ide tettem be.
-
Delila_1
veterán
válasz
bozsozso #11669 üzenetére
Alt+F11-gyel bejutsz a VB szerkesztőbe, bal oldalon kiválasztod a füzetedet, Insert menü, Module. A jobb oldalon kapott fehér lapra másolod.
Ha azt akarod, hogy a többi füzeted is elérje, a personal.xls-be másold be a kódot. Erről már többször volt szó itt a fórumon, keress rá a personal szóra.
Szerk.: megtalálod pl. a #6907-es hozzászólásban.
-
Delila_1
veterán
válasz
bozsozso #11666 üzenetére
Egy új függvény megoldja.
Function Eleje(cella As String)
Dim b%
For b% = Len(cella) To 1 Step -1
If Mid(cella, b%, 1) = " " Then
Eleje = Left(cella, b% - 1)
Exit Function
End If
Next
Eleje = "Nincs szóköz a hivatkozott cellában"
End FunctionA cellába ezt kell beírnod: =Eleje(A10) , persze csak akkor, ha az A10-ben van a szöveged, aminek az elejét akarod képezni a függvénnyel.
-
Delila_1
veterán
válasz
m.zmrzlina #11646 üzenetére
A felhasználó szabja meg, hány szót választ ki.
Ha 10 kiválasztott szóból tud 2-t, az 20%. 100 közül 20 jó válasz szintén 20% lenne, de ez a 20 darab felszorozva pl. 1,3-mal már 26 helyes válasznak felel meg, javul az elért eredmény.
A szorzó mértéke a kiválasztott szavak számától függjön, minél több szót választ ki a felhasználó, annál nagyobb legyen a szorzó.
-
Delila_1
veterán
válasz
Fire/SOUL/CD #11637 üzenetére
Igen, rossz helyre kattintottam.
Szerintem tökéletes megoldás nem létezik. A DELL szöveget kellene talán keresni, és abból kinyerni a szükséges adatokat. A többi sorhoz egy külön oszlopban megjelölni, hogy nem található a szövegrész, azokat manuálisan lehetne feldolgozni.
Így Badb0y-t sem öli meg az unalom.
Új hozzászólás Aktív témák
Hirdetés
- WLAN, WiFi, vezeték nélküli hálózat
- Telekom mobilszolgáltatások
- Milyen okostelefont vegyek?
- Vezeték nélküli fülhallgatók
- Huawei Watch 4 Pro - kívül-belül domborít
- Örülhetnek a tankok szerelmesei, jön a Spearhead 2
- One otthoni szolgáltatások (TV, internet, telefon)
- Fájdalmasan gyenge kijelzőt válaszott a Switch 2-höz a Nintendo
- exHWSW - Értünk mindenhez IS
- One mobilszolgáltatások
- További aktív témák...
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Gyermek PC játékok
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- BANKMENTES részletfizetés ASUS TUF Gaming F16 FX607JV-QT212 Notebook
- ÁRGARANCIA! Épített KomPhone Ryzen 5 5500 16/32/64GB RAM RTX 4060 8GB GAMER PC termékbeszámítással
- Bomba ár! HP EliteBook Folio 1040 G1 - i5-G4 I 8GB I 256GB SSD I 14" HD+ I Cam I W10 I Garancia!
- Telefon felvásárlás!! Samsung Galaxy S25, Samsung Galaxy S25 Plus, Samsung Galaxy S25 Ultra
- ÁRGARANCIA!Épített KomPhone Ryzen 7 5700X 16/32/64GB RAM RTX 3060 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest