Hirdetés
- Luck Dragon: Asszociációs játék. :)
- sziku69: Szólánc.
- Rap, Hip-hop 90'
- gban: Ingyen kellene, de tegnapra
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- eBay-es kütyük kis pénzért
- sh4d0w: Skywalker: Revealed
- Brogyi: CTEK akkumulátor töltő és másolatai
- sziku69: Fűzzük össze a szavakat :)
- Meggyi001: A végtelenbe...
-
LOGOUT
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
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.![;]](//cdn.rios.hu/dl/s/v1.gif)
-
Delila_1
veterán
válasz
m.zmrzlina
#11633
üzenetére
Ennek tényleg örülök, és gratulálok!

Új hozzászólás Aktív témák
Állásajánlatok
Cég: BroadBit Hungary Kft.
Város: Budakeszi
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest





![;]](http://cdn.rios.hu/dl/s/v1.gif)

Fferi50
