Hirdetés
- Mr Dini: Mindent a StreamSharkról!
- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- Brogyi: CTEK akkumulátor töltő és másolatai
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- sh4d0w: Kalózkodás. Kalózkodás?
- Magga: PLEX: multimédia az egész lakásban
- Lalikiraly: Astra kalandok @ Harmadik rész
- bambano: A sor végén
-
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
-
#53330
Fire/SOUL/CD
félisten
tgumis
#53308
válasz
tgumis
#53308
üzenetére
Most nem volt sok időm, ezért egy makrót írtam hozzá. Nem elképzelhetetlen, hogy kivitelezhető összetettebb sima képlettel is, most sajna nincs időm ezen agyalni.
Module1 kód (Topik összefoglalóban megtalálod, hogy lehet beszúrni)
Option Explicit
'Fire/SOUL/CD - 2024
Public Function Fire_CreateMenu_FX(MyCell As Variant, MyRange As Range, MyColumnIndex As Integer) As String
'MyCell -> forrás cella címe (amit fel kell dolgozni)
'MyRange -> az a tartomány (táblázat, ha úgy tetszik), ahol fel vannak sorolva a menükódok és megnevezésük
'MyColumnIndex -> tartomány (táblázat) azon oszlopa, amely a menük megnevezését tartalmazza
'elválasztó karakter (itt vessző), ezzel vannak elválasztva a menükódok a cellá(k)ban
Const MYDELIMITER = ","
'szöveg típusú dinamikus tömb
Dim MyStringArray() As String
'ciklusszámláló
Dim i As Long
'FELOSZTÁS függvény segítségével, a MYDELIMITER paraméterrel tömböt hozunk létre
MyStringArray = Split(MyCell.Value, MYDELIMITER)
'a feldolgozott, teljes menü ebbe a szöveges változóba fog kerülni
Dim MyString As String
MyString = ""
'végignézzük a tömb elemeit (kódokat a cellában, ami bármennyi lehet)
For i = 0 To UBound(MyStringArray)
On Error Resume Next
'FKERES függvény futtatása. Megkeressük az összes menükódot és összefűzzük egy darab string-be
MyString = MyString + Application.WorksheetFunction.VLookup(CInt(MyStringArray(i)), MyRange, MyColumnIndex, False)
'hibakezelés, ha olyan kód lett megadva, ami nem létezik a tartományban
If Err.Number <> 0 Then
MsgBox "A(z) " & MyStringArray(i) & " azonosító nem található a(z) " & MyRange.Address & " tartományban!"
End If
'ha nem az utolsó menükód, akkor egy vessző+szóköz párossal elválasztjuk őket egymástól
If i <> UBound(MyStringArray) Then
MyString = MyString + ", "
End If
Next i
'visszaadjuk a feldolgozott, teljes menüsort
Fire_CreateMenu_FX = MyString
End FunctionÍgy tudsz rá hivatkozni (függvény paraméterezése megegyezik az FKERES függvényével)
Megjegyzés
Menükódok csak számjegyeket tartalmazhatnak.[ Módosította: koncsik ]
-
-
#53277
Fire/SOUL/CD
félisten
tgumis
#53275
válasz
tgumis
#53275
üzenetére
Nem véletlenül kérjük, hogy írjátok meg, hogy milyen verziójú Office-t használtok, mert nem mindegy a megoldás szempontjából. Pl Fferi50 megoldását csak akkor tudod használni, ha Office 365-t használsz, mert a SZÖVEGFELOSZTÁS függvény csak abban érhető el.
Itt egy "csúnya" megoldás, ha régebbi Office-t (2021 vagy korábbi) használnál.
=HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(A18;"0";"t");"1";"u");"2";"v");"3";"w");"4";"x");"5";"y");"6";"z");"7";"{");"8";"|");"9";"}");",";" ")
Megjegyzés
Szóközre cseréltem a vesszőket, jobb áttekinthetőség miatt, mert ha egymás mellé kerülnek közvetlenül a Windings2 karakterek, akkor bizonyos esetekben nem lesz egyértelmű, pl. 1,12 esetén 112 lesz, de ez jelenthet 1 és 12 allergént, de olvasható 11 és 2-nek is és az nem mindegy.
Ha ennek ellenére nincs szükség a szóközös elválasztásra, akkor a képlet végén közvetlenül a bezárójel előtt, töröld a macskakörmök közül a szóközt. -
Fferi50
Topikgazda
válasz
tgumis
#53275
üzenetére
Szia!
Az allergiát jelölő cellák betűtípusát állítsd Windings 2 -re.
Ezután a képlet a következő (a kép alapján):=SZÖVEGÖSSZEFŰZÉS("";1;KARAKTER(SZÖVEGFELOSZTÁS(H1;",")+116))
Mit látsz a képen?7
A oszlopban a H oszlopban levő jelölések átírt értéke.
D oszlopban a számok, E oszlopban a Windings 2 karakterek, F oszlopban a nekik megfelelő "normál" karakterek, G oszlopban a karakter kódok.
Mivel a karakter kódok 117-től indulnak, a képletben 116-ot kell hozzáadni az allergén kódjához.
Figyeld meg, hogy a 10 feletti kódokban ugyanúgy vesszővel kell elválasztani a két értéket, mintha egy szám lenne a kód - a képlet működése miatt.
Remélem, vannak ilyen függvényeid az Exceledben. Ha nincsenek, akkor valószínűleg csak makróval megy a dolog.
Üdv. -
Fferi50
Topikgazda
válasz
tgumis
#51788
üzenetére
Szia!
"Lehet erre makrót csinálni?"
Igen, persze. Az Excel makróból lehet a Word dokumentumokat is kezelni. Ehhez a VBA-ban a Tools - References-ben be kell jelölni a Microsoft Word ... megfelelő verziójú Object Libraryt. Ezután elérhetően a Word objektumai, az objektumok metódusai és tulajdonságai. A VBA helpben megtalálhatod, hogyan kell megnyitni a Word alkalmazást és használni.
Azért lenne kérdésem is:
Ha egyszer képként mented, akkor mit csinálnak a Word doksival és miért nem jó a PDF (bár a mentés ott is érdekes lehet)?
A Word-ben csinálhatsz egy sablont, ami tartalmazza a szükséges formai dolgokat (pl. margó) és azt megnyitva csak a képet kell bemásolni.
Üdv.
Ps. Priviben pontosabb adatok megadása esetén tudok segíteni. -
#51717
Fire/SOUL/CD
félisten
tgumis
#51715
-
#51700
Fire/SOUL/CD
félisten
tgumis
#51698
-
Fferi50
Topikgazda
válasz
tgumis
#49702
üzenetére
Szia!
Azt gondolom, ez egy elég csúnya bug Redmond részéről. Azt a tartományt, amely relatív módon végződik, a mindenkori utolsó sorig egészíti ki, a kiterjesztés sorától kezdve. Talán érdemes lenne ezt megírni a MS-nek.
Átmeneti kiküszöbölésére javaslok egy olyan képletet, ahol közvetett módon jelöljük ki a tartományt, a B5 cella képlete:=DARABTELI(ELTOLÁS($A$5;0;0;SOR()-4;1);A5)
Ez tesztelésem szerint megfelelően működik a kiterjesztés során is.
Üdv. -
-
Fferi50
Topikgazda
válasz
tgumis
#49697
üzenetére
Szia!
Szerintem a táblázatod "túl van bővítve", a 28-dik sortól törölni kellene a sorokat belőle.
Ha be van állítva a speciális fülön, hogy Adattartomány végén a formázás és a képletek folytatása, akkor új sor hozzáadása után nem kell a képleteket beírnod.
Valószínűleg úgy keletkezett a jelenség nálad, hogy az ominózus sorokban volt egyszer már adat, csak kitörlődött. Ilyenkor a képletek megmaradnak, nem szűkül a táblázat automatikusan.
Üdv. -
Mutt
senior tag
válasz
tgumis
#49068
üzenetére
Szia,
PQ-ben igazából az adattípust tudod állítani (szöveg, egészszám, törtszám, dátum stb), ami a könnyebb olvashatóság miatt hoz is egy formátumot (amit a Windows Területi beállításaiból vesz ki, de a LOCALE opcóval eltérhetsz tőle).
Amikor az eredményt munkafüzetre küldi a PQ, akkor ha nincs cellaformázás (vagyis General/Általános-ra) van állítva, akkor használja az alapot, különben pedig a cellaformátumát.A mintád alapján 2 dolog lehet:
1. 2385-ös sortól lefelé lehet hogy számformátum van a cellákra állítva.
2. Dátum adattípus konverziónál hiba történt és valójában nem dátum adattípust használ. Amikor kiküldöd a munkalapra az adatsort akkor a Connections/Kapcsolatok alatt kiírja hogy pl. 3500 rows loaded (with 500 errors).üdv
-
Fferi50
Topikgazda
-
Fferi50
Topikgazda
válasz
tgumis
#49068
üzenetére
Szia!
Talán a munkalapon van olyan nem látható dolog, ami ezt előidézi.
Nézd meg légy szíves az F5 - ugrás - irányított - utolsó cella eredménye mi. Ha ez túl van az "értelmesen" használt tartományon, akkor ez lehet az esetleges oka. Ebben az esetben töröld ki a teljes sorokat a normál tartomány végétől az eddigi sorig.
A mindent töröl opció sajnos hagyhat szemetet még hátra.
Üdv. -
Fferi50
Topikgazda
válasz
tgumis
#49065
üzenetére
Szia!
Gyakorlatilag a dátum is számként van tárolva az Excelben. A "hibásan" betöltött értékeket megformázhatod dátumként, helyes értékeket fogsz kapni.
Valószínű, hogy azon a munkalapon - (vagy a txt-ben?) - van egy "kapcsoló", ami nem engedi tovább a dátum formátumot, hiszen új munkalapon "hibátlan" a betöltés.
Üdv. -
-
logitechh
csendes tag
válasz
tgumis
#45963
üzenetére
Szia!
A kép alapján megcsináltam a táblát.
ha jól értettem íme a megoldás:
S2cellába =HA(ÉS(H2="ha";N2="F";I2>=2009;AC2=3;P2<>0);HA(P2<=0,0833333333333333;P2;0,0833333333333333);"")
T2 cellába
=HA(ÉS(H2="ha";N2="F";I2>=2009;AC2=3;P2>=0,0833333333333333);HA(P2<=0,166666666666667;P2-0,0833333333333333;0,0833333333333333);"")
U2 cellába
=HA(ÉS(H2="ka";N2="F";AC2=3);Q2;HA(ÉS(H2="ha";N2="F";I2>=2009;AC2=3;P2>0,166666667);P2-0,166666667;HA(ÉS(H2="ha";N2="F";I2>=2009;AC2<>3;P2>0);P2;HA(ÉS(H2="ha";N2="F";I2<2009);Q2;""))))
A #### probléma a negatív előjel miatt jöhet (konkrétan nem írtad meg mitől)elő márpedig ha valaki nem dolgozza le az előírt munkaórát (ezt a napközbeni távoltöltött iső kivonásával tudodorvosolni) és a olyankor a túlóra kissebb mint nulla vagyis negatív lesz.
-
lappy
őstag
válasz
tgumis
#45963
üzenetére
Szia!
Van benne egy kis ellentmondás:
"fizetős verziót választja annak aki 2009 után lépett be " később
"2009 után belépett raktáros minden óra 100%" akkor most melyik igaz?A HA függvényben az első résznél használj ÉS függvényt pl.: ha(és(B8="raktáros";B9<2009;dátum vizsgálat);....)
"2 óra alatti a túlóra akkor #### jelenik meg" ehhez látni kellene a függvényt hogy miért is ez a válasz. -
Fferi50
Topikgazda
válasz
tgumis
#45671
üzenetére
Szia!
"kiderül, hogy az 54 gr-os 25 ft-ért a jó"
Tehát a probléma megoldva.
(Mondjuk ebben az esetben akár "ránézésre" is kibökhető, hogy a legnagyobb súlyú a legolcsóbb, nyilván az a leggazdaságosabb... - tudom, példa lehet rossz is
)
Mi akkor a gond? A képlet jó, az eredményt le tudod olvasni.
Igazából nem értem a kérdésed.
Üdv. -
Fferi50
Topikgazda
válasz
tgumis
#45652
üzenetére
Szia!
Ahogyan a másik fórumon is írtam, a K oszlop képlete a hibás. Darabos termék esetén korrigálni kell a C oszlopban levő darabsúly értékével.
https://pcforum.hu/tudastar/145152/excel-fajlagos-arak-osszehasonlitasa
Üdv. -
Fferi50
Topikgazda
válasz
tgumis
#42405
üzenetére
Szia!
Ha a "célfüzetben" szeretnél tovább dolgozni, akkor más megoldást célszerű alkalmazni.
A forrás munkalapodat is hozzárendelheted egy változóhoz a cél megnyitása előtt (ez fontos, előtte), utána a másolás miatt nem kell megváltoztatni az aktív munkafüzetet.
Pl.Dim forras as WorkSheetSet forras=ActiveSheet---ide jön a célfüzet megnyitásaSet celfuzet=ActiveWorkbookforras.Range(Range("A2"), Range("K2").End(xlDown)).Copy Destination:=celfuzet.Sheets("anyagbiz_lista").Range("Anyagbiz[Anyagbiz-szám]")
Mivel nem változtattuk meg az aktív munkafüzetet, a másolás után is a celfuzet marad aktív.Az aktív munkafüzet megváltoztatása nélkül lehet műveleteket végezni, ha a munkafüzeteket/munkalapokat változóhoz rendeljük és a makróban a változókat használjuk hivatkozásként.
Üdv.
-
Fferi50
Topikgazda
válasz
tgumis
#42394
üzenetére
Szia!
A Windows helyett én a Workbooks -ot használnám, az jelöli ki egyértelműen a munkafüzetet. (Tudom, a makrórögzítés a Windowst használja
)
Bevezetnék változókat a munkafüzetekre.
Gondolom ahova másolni kell, azt a munkafüzetet a felhasználó választja ki és nyitja meg.
Nos a megnyitáskor ezt a munkafüzetet hozzárendelném pl. egy celfuzet nevű változóhoz. A továbbiakban pedig ezt használnám hivatkozásként.
pl.Set celfuzet =ActiveWorkbook '(mivel megnyitás után az új füzet lesz aktív)
A copy után meg lehet adni közvetlenül a másolás helyét, ha mindent másolsz.
pl.Range(Range("A2"),Range("K2").End(xlDown)).Copy Destination:=celfuzet.sheets(1).Range("Anyagbiz[Anyagbiz-szám]")
A munkafüzet mellett meg kell adni a munkalapot is(!), akkor is, ha csak egy munkalap van benne.Üdv.
-
-
Fferi50
Topikgazda
válasz
tgumis
#42385
üzenetére
A törlő makró:
Sub torlo()Sheets("sheetneve").Listobjects("anyagbiz").DataBodyRange.DeleteEnd Sub
A sheetneve helyére írd a munkalap nevét, ahol a táblázatod van.
Gondolom, az anyagbiz a táblázatod neve. Ha a munkalap neve, akkor a sheetneve helyére kell beírnod, a helyére pedig a táblázatod nevét.
Üdv. -
Pakliman
tag
válasz
tgumis
#40459
üzenetére
Szia!
Még egyszerűbben, villogtatás nélkül:
Sub keplet_helyett_ertek()
Dim ws As Worksheet
On Error Resume Next
For Each ws In Worksheets
ws.Cells.SpecialCells(xlCellTypeFormulas, 23).Formula = ws.Cells.SpecialCells(xlCellTypeFormulas, 23).Value
Next ws
On Error GoTo 0
End Sub
-
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 -
ny.janos
tag
válasz
tgumis
#40222
üzenetére
Szia!
Ha A1 igaz-hamis értéke egy logikai vizsgálat eredménye, akkor a logikai vizsgálatot végző képletet az adatérvényesítés - egyéni - képlet-tel megadva meg tudod valósítani, hogy ne engedjen adatot bevinni, ha a logikai vizsgálat eredménye hamis. (Részletesen a súgóban - érvényesítés - megtalálod a tartalom utolsó pontjában.)
Viszont az A1 cellára úgy vizsgálni, hogy az szövegesen tartalmazza az igaz-hamis értéket vagy a logikai vizsgálat képletét nem tudsz. -
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.
-
Delila_1
veterán
-
Fferi50
Topikgazda
válasz
tgumis
#39533
üzenetére
Szia!
Feltöltöttem ide egy javaslatot:
A Törzsszám oszlopra létrehoztam egy nevet.
A Munka2 munkalap a "beviteli" munkalap. Itt a C oszlop a törzsszám. Az első pár cellára megcsináltam az adatérvényesítést, ahol az érvényes lista a Törzsszám. Ez a mindenkori tényleges adatokat fogja tartalmazni a név meghatározása miatt.
A többi oszlopban az Index - Hol.van képlet páros játszik.
A bevitel rögzítéséhez szükséges volt egy makró. Ez egyrészt beviszi az adatot a Munka1 tábla megfelelő helyére, másrészt visszaállítja a kereső képletet (mivel az új érték beírásával az eltűnne).Remélem, valami ilyesmire gondoltál.
Üdv.
PS. A törzsszám generálásra egy javaslatot a Munka1 munkalap DA oszlopában találsz. Ebben az esetben garantált az azonos törzsszámok elkerülése.
-
Delila_1
veterán
válasz
tgumis
#39530
üzenetére
Semmi szükség külön lapra, ahol megdupláznád az adataidat.
Az utolsó lapon a címsorba autoszűrőt teszel, szűrsz törzsszámra, vagy névre, és beírod a kiadott ruhadarabot.
Több névre is szűrhetsz.Nézd meg az adatokat! Azonos törzsszámmal rendelkezik Tóth Éva Püspökladányból, és Takács Éva Békéscsabáról. Van, aki Bp. Nyugatiban, és Záhonyban is szerepel. Összesen 4 ilyen párod van. Használd a DARABTELI függvényt a kikeresésükhöz!
-
Fferi50
Topikgazda
válasz
tgumis
#39238
üzenetére
Szia!
Ez a makró egy eseményhez kapcsolódik, ami egy adott helyzetben fut le. Ezért van munkalaphoz kötve.
Semmi nem tiltja azonban, hogy egy parancsgomb megnyomása esetén ezt az eseményt hívja meg a makró, de akkor át kell adja a target paraméter értékét:Sub makro1
Worksheet_Change Range("A1") vagy Range("A1") helyett Selection
End Sub
A gombhoz a makro1-et kell rendelni.
Ez az eseménykezelő Private, azaz csak azon a munkalapról lehet meghívni, amelyikhez rendelted. Általános kódlapra nem teheted, de amit csinál (ami Sub - End Sub között van) lehet modulba tenni, természetesen megfelelő körültekintéssel.
Az eseménykezelést lehet a Thisworkbook kódlapjára is tenni, ott aPrivate Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'műveletek
End Sub
tartalmazhatja a feladatokat. Itt látod két paraméter van, az Sh az a munkalap, amelyen az esemény történt, a Target pedig az a tartomány ahol történt. Ebben az esetben elég ide betenni a műveleteket, természetesen figyelve arra, ha egyik munkalapon más műveletet szeretnénk, mint a másikon. Ezt az Sh paraméter alapján dönthetjük el.
Remélem jól értettem a kérdésed, mert számomra nem volt eléggé világos.Üdv.
-
Delila_1
veterán
válasz
tgumis
#39234
üzenetére
Rendeld a laphoz ezt a makrót.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$K$1" Then
Application.EnableEvents = False
Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Target
Range("A1").CurrentRegion.Offset(1).Select
Selection.SpecialCells(xlVisible).Delete shift:=xlUp
ActiveSheet.Range("$A$1:$F$1").AutoFilter Field:=1
Application.EnableEvents = True
Range("A2").Select
End If
If Target.Address = "$N$1" Then
Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=Target
End If
End Sub -
Delila_1
veterán
válasz
tgumis
#37547
üzenetére
A védelmet az értékadások alá tedd!
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
usor = WSBev.Range("D2").End(xlDown).Row
'lapok védelmének feloldása a makró számára
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True -
Delila_1
veterán
válasz
tgumis
#37542
üzenetére
A hiba azért lépett fel – amire korábban felhívtam a figyelmedet –, mert a makró végén a bevitel lap jelszavát módosítottuk pw-ről LiliLufi140127-re. Ha továbbra is meg akarod hagyni a pw-t, akkor az utolsó utasítást egyszerűen töröld ki a makróból.
Ezt kell kihagynod.
WSBev.Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, _
AllowFiltering:=True, AllowFormattingColumns:=TrueÚgy tűnik, hiába írtam le már többször, hogy a
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=Truesorok a 2 lapot a makró számára írhatóvá teszik, nem kell külön a makró elején felszabadítani, a végén pedig védetté tenni a lapokat.
-
Delila_1
veterán
válasz
tgumis
#37537
üzenetére
A makró elejére beírtam a kérdést, a vége felé meg ott van a képletek másolása.
Sub Szur_Masol_Torol()
Dim usor As Long, WSBev As Worksheet, WSOsz As Worksheet
Dim Bsor As Long, Csor As Long, valasz
valasz = MsgBox("Áttölthetem az adatokat?", vbYesNo + vbQuestion, "Választás")
If valasz = vbNo Then Exit Sub
'lapok védelmének feloldása a makró számára
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
usor = WSBev.Range("D2").End(xlDown).Row
'szűrés OK-ra
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK"
'másolás és érték beillesztés
WSBev.Range("D2:T" & usor).Copy
WSOsz.Range("C" & Bsor).PasteSpecial xlPasteValues
'képlet, majd érték beillesztés a B oszlopba
Csor = WSOsz.Range("C" & Rows.Count).End(xlUp).Row
WSOsz.Range("B" & Bsor & ":B" & Csor) = "=B" & Bsor - 1 & "+1"
WSOsz.Columns(2).Copy
WSOsz.Range("B1").PasteSpecial xlPasteValues
'T2:W2 képlete az új sorokba az Összesítés lapon
WSOsz.Range("T2:W2").Copy
WSOsz.Range("T" & Bsor & ":W" & Csor).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False 'kijelölés megszüntetése
With WSOsz.Range("B1").CurrentRegion 'keretezés
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17 'OK-ra szűrés megszüntetése
WSBev.Range("D2:E200,G2:G200,H2:I200,B1:B6").ClearContents 'törlés
'új jelszó a bevitel laphoz
WSBev.Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, _
AllowFiltering:=True, AllowFormattingColumns:=True
End Sub -
logitechh
csendes tag
válasz
tgumis
#37538
üzenetére
Neked erre van szükséged
Nem olyan stílusos mint Delila_1 megoldása de funkciójában ez tökéletesen működikSub szur_masol_beilleszt_torol()
Sheets("bevitel").Unprotect Password:="pw"
Sheets("összesítés").Unprotect Password:="pw"
Sheets("összesítés").Select
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter
Sheets("bevitel").Select
Sheets("bevitel").Range("D2").Activate
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK", Operator:=xlAnd
usor = Range("D2").End(xlDown).Row
Range("D2:T" & usor).Select
Selection.Copy
Sheets("összesítés").Select
Dim Asor As Long
Dim Bsor As Long
Dim i As Integer
Asor = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("B" & Asor).PasteSpecial xlPasteValues
Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1
Range("S2:V2").Copy Destination:=Range("S" & Asor & ":S" & Bsor - 1)
For i = Asor To Bsor - 1
Range("A" & i) = Range("A" & i - 1) + 1
Next i
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
Sheets("összesítés").Protect Password:="pw", UserInterfaceOnly:=True, AllowFiltering:=True,
AllowFormattingColumns:=True
Sheets("bevitel").Select
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17
Range("D2:E200,G2:G200,H2:I200").Select
Range("H2").Activate
Range("D2:E200,G2:G200,H2:I200,B1:B6").Select
Range("B1").Activate
Selection.ClearContents
Selection.ClearContents
Sheets("bevitel").Protect Password:="pw", UserInterfaceOnly:=True, AllowFiltering:=True,
AllowFormattingColumns:=True
End SubA message bax-al történő makró vezérlése viszont engem is érdekel. Szóval ha igen lefusson a makró ha nem akkor meg nem. Arra tud valaki olyan példát amiből ki lehet ezt venni és más makrókhoz felhasználni
-
Delila_1
veterán
válasz
tgumis
#37532
üzenetére
A lenti sor a MAKRÓ részére feloldja a lap védettségét.
Sheets("Lapneve").Protect Password:="pw", UserInterfaceOnly:=TrueHa előtte nem volt levédve a lap, akkor a beírt jelszóval védetté teszi.
Minek ehhez 3 makró? Eggyel is meg lehet oldani. Arra kell ügyelned, hogy a jelszó a bevitel lapon a makró végén megváltozik (pw-ről LiliLufi140127-re), legközelebb indításkor az újat kell megadnod.
Sub Szur_Masol_Torol()
Dim usor As Long, WSBev As Worksheet, WSOsz As Worksheet
Dim Bsor As Long, Csor As Long
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True
'szűrés OK-ra
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK"
'másolás és érték beillesztés
usor = WSBev.Range("D2").End(xlDown).Row
WSBev.Range("D2:T" & usor).Copy
WSOsz.Range("C" & Bsor).PasteSpecial xlPasteValues
'képlet, majd érték beillesztés a B oszlopba
Csor = WSOsz.Range("C" & Rows.Count).End(xlUp).Row
WSOsz.Range("B" & Bsor & ":B" & Csor) = "=B" & Bsor - 1 & "+1"
WSOsz.Columns(2).Copy
WSOsz.Range("B1").PasteSpecial xlPasteValues
Application.CutCopyMode = False 'kijelölés megszüntetése
With WSOsz.Range("B1").CurrentRegion 'keretezés
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17 'OK-ra szűrés megszüntetése
WSBev.Range("D2:E200,G2:G200,H2:I200,B1:B6").ClearContents 'törlés
'új jelszó a bevizel laphoz
WSBev.Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, _
AllowFiltering:=True, AllowFormattingColumns:=True
End Sub -
tgumis
tag
válasz
tgumis
#37447
üzenetére
hA ESETLEG VALAKINEK SZÜKSÉGE VAN RÁ ÉS ÉRDEKLI MEGOLDÓDOTT:
=HA([@mennyiség]>0;HA(ÉS(DARABTELI(bevitel[@[Megnevezés]:[me]];"ERROR")=0;(VAGY((HA([@mennyiség]=1;"IGAZ";"HAMIS"))="IGAZ";(HA([@mennyiség]-DARABÜRES([@EAZ])+1=[@mennyiség];"IGAZ";"HAMIS"))="IGAZ"));DARABÜRES(bevitel[@[kód]:[mennyiség]])=0;(VAGY([@[Utalvány szám]]<>0;[@[E.biz.szám.]]<>0));[@átadó]<>0;[@átvevő]<>0);"OK";"NEM OK");"")=HA([@mennyiség]>0;HA(ÉS(DARABTELI(bevitel[@[Megnevezés]:[me]];"ERROR")=0;(VAGY((HA([@mennyiség]=1;"IGAZ";"HAMIS"))="IGAZ";(HA([@mennyiség]-DARABÜRES([@EAZ])+1=[@mennyiség];"IGAZ";"HAMIS"))="IGAZ"));DARABÜRES(bevitel[@[kód]:[mennyiség]])=0;(VAGY([@[Utalvány szám]]<>0;[@[E.biz.szám.]]<>0));[@átadó]<>0;[@átvevő]<>0);"OK";"NEM OK");"")
-
Delila_1
veterán
válasz
tgumis
#34325
üzenetére
Nekem is ez a bánatom, hogy a kb. 180 választható ikon közül egyik sem adja vissza a saját makróim lényegét.
Valahol olvastam, hogy ehhez le kell tölteni egy alkalmazást. Úgy döntöttem, inkább megjegyzem, hogy pl. a karakterek és hátterek színének lekérdezéséhez a színes pillangó ikont rendeltem.
-
Fferi50
Topikgazda
válasz
tgumis
#31458
üzenetére
Szia!
A makróban konkrétan meg van adva a mentési név " "C:\Users\tgumis\Desktop\Munkafüzet1.xlsm","
Ha te szeretnéd megadni a nevet, akkor
Application.Inputbox metódussal, vagy az Inputbox függvénnyel kérd be a nevet egy változóba:
ujnev=Application.Inputbox ' a paramétereit lsz. nézd meg
utána a név helyére beírod az ujnev változót.Üdv.
-
Fferi50
Topikgazda
válasz
tgumis
#31337
üzenetére
Szia!
Valami hibaüzenetet csak ír ki ugye? Azt kellene ide beírnod.
Elképzelhető, hogy az a probléma, hogy kétszer van benne a
"Dim oszlop As Integer "
sor az "összefűzés" után. Ezért a második ilyen sort ki kell törölni vagy kikommentelni (egy aposztróf az elejére).Én a Data.hu -ra szoktam feltenni a megmutatni szándékozott fájlokat, de rengeteg egyéb lehetőség is van, elég, ha csak végignézed a probléma felvetésekben szereplő linkeket...
Üdv.
-
Delila_1
veterán
válasz
tgumis
#31316
üzenetére
Azt nem írtad, hogy a G15:G423 adatai melyik lapon vannak. Feltételezem, hogy az adat lapon.
Tehát a nap a kezdőlap B1 cellája, a másolandó adatok az adat lap G15:G423 tartománya, és az összesítő lap megfelelő oszlopába, a 2. sortól kezdve kell bemásolni. Az összesítő lapon a H oszlop a hónap első napja.Sub Osszesites()
Dim oszlop As Integer
oszlop = Sheets("kezdőlap").Range("B1") + 7
Sheets("adat").Range("G15:G423").Copy Sheets("összesítő").Cells(2, oszlop)
End Sub -
Nowitzki
csendes tag
válasz
tgumis
#31203
üzenetére
Próbáld meg ezt:
Sub fejlec_formazas()
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
With ws
.Activate
.Unprotect Password:="Lufi09"
With ActiveWindow
.FreezePanes = False
Range("A10").Select
.FreezePanes = True
End With
.Range("I1:I3").Interior.Color = RGB(204, 192, 218)
With .Range("B1:D3,B8:D158,I8:J158,M8:N158,P8:P158,S8:V158,Y8:Y158")
.Locked = False
.FormulaHidden = False
End With
If .AutoFilterMode Then .Cells.AutoFilter
.Range("A6:J6").AutoFilter
' kódolás
.Protect Password:="Lufi09", _
UserInterfaceOnly:=True, _
AllowFormattingColumns:=True, _
AllowFiltering:=True
.EnableSelection = xlNoRestrictions
End With
Next ws
Application.ScreenUpdating = True
End Sub -
bteebi
veterán
válasz
tgumis
#31080
üzenetére
Ha jól értettelek, akkor valami ilyesmi jó lesz:
Sub szamoz()
sorsz = 1
For xx = 2 To 22
If Not Cells(xx, 1).EntireRow.Hidden Then
If Cells(xx, 1).MergeArea.Rows.Count = 1 Then
Cells(xx, 1).Value = sorsz
sorsz = sorsz + 1
ElseIf Cells(xx, 1).MergeArea.Rows.Count > 1 And Cells(xx - 1, 1).MergeArea.Rows.Count = 1 Then
Cells(xx, 1).Value = sorsz
sorsz = sorsz + 1
End If
End If
Next xx
End Sub -
-
Delila_1
veterán
válasz
tgumis
#30768
üzenetére
Úgy látom, itt nem az oszlopok elrejtéséről van szó, hanem arról, hogy nem fér el az utolsó oszlop a lapon.
A Nyomtatási kép menüben hívd be az Oldalbeállítást, ott az Oldal fülön a nagyítás vedd le az eredeti méret 80%-ára. Próbálkozhatsz kisebb-nagyobb átállítással. A Margók fülön módosíthatod a margók szélességét, és az igazítást is beállíthatod, hogy a lap közepén legyen a kinyomtatott szöveg.
A 3. fülön bevihetsz élőfejet, élőlábat, a 4. fülön megadhatod például a fent ismétlődő sorokat ( az esetedben 1:4).
-
Delila_1
veterán
válasz
tgumis
#30739
üzenetére
Próbáld meg ezzel
Sub Oldaltores()
Dim sor As Long, darab As Integer, ny As Long
darab = Application.InputBox("Hány soronként legyen oldaltörés?", "Szám bekérése", , , , , , 2)
sor = 1
Do While Cells(sor, "A") <> ""
If Rows(sor).Hidden = False Then ny = ny + 1
If ny Mod darab = 0 Then
Cells(sor + 1, 1).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
ny = 0
End If
sor = sor + 1
Loop
End Sub
Mit látsz a képen?7
Az Option Explicit nem kell... (vagy azt csinálod, amit Fferi50 írt, viszont innentől minden változót deklarálni kell) 
(Esetleg valami makró nem piszkálhat bele?)
Új hozzászólás Aktív témák
Fferi50- Telefon felvásárlás!! Samsung Galaxy A12/Samsung Galaxy A22/Samsung Galaxy A32/Samsung Galaxy A52
- Gamer egerek és billentyűzetek kitűnő árakon!
- Lenovo L14 Thinkpad Gen2 FHD IPS i5-1135G7 16GB RAM 256GB SSD Intel Iris XE Win11 Pro WiFi6 Garancia
- Samsung Galaxy S21 5G 128GB, Kártyafüggetlen, 1 Év Garanciával
- Xiaomi Redmi 12C 64GB, Kártyafüggetlen, 1 Év Garanciával
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Promenade Publishing House Kft.
Város: Budapest