Hirdetés
Talpon vagyunk, köszönjük a sok biztatást! Ha segíteni szeretnél, boldogan ajánljuk Előfizetéseinket!
-
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
-
#53460
Fire/SOUL/CD
félisten
eszgé100
#53459
-
Mutt
senior tag
válasz
eszgé100
#53449
üzenetére
Szia,
Tudnál egy mintát mutatni, hogy miből mit kéne varázsolni?
A FILTER vagy AGGREGATE függvénnyel tudunk azonos találatok közül szelektálni, de kevés a fenti infó.
Pl. ez a lapon lévő utolsó sorból ad vissza eredményt a feltételek szerint:
=LET(r,FILTER([dateTime],([SerialNumber]=[@SerialNumber])*ISNUMBER(SEARCH([boltID],"PROGRAMNAME"))),INDEX(r,COUNT(r))) -
Mutt
senior tag
válasz
eszgé100
#53146
üzenetére
Szia,
...egyiket kovetve sem jartam sikerrel.
Mi történik a te esetedben? M-kódot tudod mutatni az első queryhez, ami az eredeti forrásfájlból dolgozik?Mindegyik video ugyanazt magyarázza el, vagyis hogy:
1. egy query-vel elkészíted a kommentek nélküli változatot, amit betöltesz egy munkalapra.
2. hozzáadod a szükséges oszlopokat a frissen betöltött táblázathoz, majd ezt a táblázatot is betöltöd Power Query-be és kijösz Power Query-ből úgy hogy ezt csak kapcsolatként (Close and load -> Only create connection) töltöd be
3. Visszamész Power Query editorba és az eredeti lekérdezésben állva összefűződ (Home -> Merge Queries) azt a másodikkal (amiben van a komment és csak kapcsolatként él).
4. Kibontod az új oszlopokat az összefűzés után.
5. Close and Load-al visszamész Excelbe, ahol duplán lesznek az új oszlopok. Tőrlőd a végéről a duplikáltakat.A videokról egy kis észrevétel:
1. Egyik sem hangsúlyozza igazán de kell egy kulcs mező ami alapján meg lehet találni a két helyen az azonos sorokat. Mindegyik esetben van egy ID oszlop, de PQ esetén akár több oszlop is használható elsődleges kulcsként.
2. A második videót kerüld, addig amíg M-kód közvetlen szerkesztésében nem vagy jártas.
3. A harmadikban szereplő oktató megbízható (mindhárom video helyes megoldást ad ettől függetlenül).Amit lehetne finomítani - főleg ha nagy adatsorod van - hogy a második query csak a kulcsmezőket és a kommenteket tartalmazza, minden egyéb adat csak a memóriát eszi feleslegesen, de ez minimális dolog.
üdv
-
Fferi50
Topikgazda
válasz
eszgé100
#52677
üzenetére
Szia!
Az előzőhöz kiegészítésként:
Az idézőjeleket duplikálni kell a szövegen/képleten belüli megjenéshez.
Ezen kívül a táblázatra hivatkozás sem megfelelő.
Táblázatnév [@mezőnév] a helyes, továbbá szóköz nem lehet benne.
Vidd be a cellába egérmutatással a képletet és utána megnézni az immediate ablakban, hogyan néz ki. (Pl. ? Activecell.Formula2 és enter). Ezt használhatod az idézőjelekre vonatkozó szabály figyelembe vételével.
Üdv. -
-
eszgé100
őstag
válasz
eszgé100
#52580
üzenetére
Option Compare TextFunction PartName(s As String) As StringSelect Case TrueCase s Like "20502#[A-Z]##[A-Z]###"PartName = "Part1"Case s Like "###A-Z]######"PartName = "Part2"Case s Like "8212-9a-zA-Z]##########"PartName = "Part3"Case s Like "822846######"PartName = "Part4"'etc...End SelectEnd Functionez lett a vege
-
Fferi50
Topikgazda
válasz
eszgé100
#52575
üzenetére
Szia!
Még lenne egy gondolatom:
Beszívod mindenütt szövegként a dátum oszlopot. Ebben az esetben az AM-PM nek ott kell lennie az oszlopban ha jól gondolom.
Kiszűröd azokat a sorokat amelyekben nincs AM-PM (szövegszűrő nem tartalmazza AM és nem tartalmazza PM.
Az így létrejött "maradék" táblát mented egy munkalapra.
Ezután visszamész a lekérdezés szerkesztésbe. Törlöd az előző szűrőt és beállítod a szövegszűrőt tartalmazza AM vagy PM.
A bal oldalon a táblázat nevére jobb egérgomb - Megkettőzés (így nem kell ismételten beolvasnod)
A második táblában: Dátum oszlop felosztása / alapján. A hónap és nap oszlop felcserélése. A három oszlop egyesítése. A nem szükséges oszlopok kitörlése. Az oszlopok elnevezése mint az előző lekérdezésben, ha szükséges.
Ezután Bezárás és betöltés adott helyre - egy másik munkalapra érdemes.
Ezután az Excelben a lekérdezése állva - lekérdezések egyesítése - kiválasztod a két lekérdezést és egyesíted.
Szerintem rövidebb ideig tart, mind ezt itt elolvasni.
Automatizálni is lehet szerintem.
Üdv. -
Fferi50
Topikgazda
válasz
eszgé100
#52568
üzenetére
Még folytatnám, erre a kérdésre
"Hasonló logika alapján meg lehet oldani ezt Power Query-ben is?"
Power Query előnézetben szövegnek választani a dátumot tartalmazó oszlopot.
Ezután a dátumot tartalmazó oszlop kijelölése - Átalakítás fülön oszlop felosztása - határolójellel - beírod az egyéni határolójelet ("/"). Létrejön 3 oszlop. US szerint HH, NN, ÉÉ és idő . Ezután a HH NN oszlopot megcseréled. Kijelölöd a 3 oszlopot. Átalakítás fülön oszlopok egyesítése - elválasztójellel - egyéni "/". Ezt valószínűleg a végére szúrja be. Ez most még szöveg, ezért a Kezdőlap fülön Adattípusban Dátum/Időt kiválasztod és OK.
Ezek után a szétszedéskor keletkezett 3 oszlopod törölhető.
Persze ez ilyen módon csak akkor műxik, ha nem vegyesen fordulnak elő a dátum formátumok az oszlopban.
Üdv. -
Fferi50
Topikgazda
válasz
eszgé100
#52568
üzenetére
Szia!
Egy teljesen vad kérdés:
Mi történik, ha nem azonnal "behúzod", hanem az adatok átalakítását választod?
Ezután a Dátum oszlopra az adattípus módosításánál kiválasztod a tizedes törtet.
Elvileg ebben az esetben a dátumok számmá változnak. Utána pedig visszaállíthatod dátum formátumúra.
Másik gondolat:
Nem tudom, hogy keverve vannak-e a formátumok vagy külön forrásban vannak.
Ez Excelben az Adatok - Szövegből oszlopok varázslóban a 3. lépésben meg tudod adni a dátum formátumot mint forrást.
Üdv. -
Mutt
senior tag
válasz
eszgé100
#50736
üzenetére
Szia,
DAX-ban van olyan hogy implicit és explicit measure. Mindegyiknek van előnye és hátránya, implicit könnyebben átlátható, de lassabb, az explicit gyorsabb de nehezebb is.
Amikor segédoszlopokról beszélsz, akkor az implicitet jelent. Explicit esetén nincs segédoszlop, hanem a képlet számolja real-time az eredményt azon adatok alapján amit a szűrők átadnak neki (itt fontos megemlítenem a row-context és filter-context koncepciót).
Tudsz nested IF-et használni és ha tudod egy képletben összerakhatod az összes ellenőrzést.
Nem javasolnám a 20+ oszlop létrehozását csak emiatt, de mivel még ismerkedsz vele szerintem nem gond ezen az úton elindulni. Azonban nem tudom elképzelni hogyan tudsz majd ilyen esetben szűrni, hiszen néha egyik, néha másik oszlop alapján kell majd neked eredmény.Power BI-ban lehet Python szkripteket futtatni, ahol már van regex, így ha túl bonyolult lenne DAX-al megoldani akkor ezen is lehet elindulni.
üdv
-
Mutt
senior tag
válasz
eszgé100
#50731
üzenetére
Szia,
Power Tools-ban (BI/Query/Pivot) nincs alapból REGEX, így ezt a macerás képletet tudom ajánlani.
IS_ACCURATE =
var helyes_hossz = 20
var hossz = len([Minta]) = helyes_hossz //megfelelő a hossz?
var csoport1 = Not(ISERROR(VALUE(LEFT([Minta]; 3)))) //első 3 karakter szám?
var csoport2 = Not(ISERROR(SEARCH(MID([Minta];4;1);"ABCDEFGHIJKLMNOPQRSTUVWXYZ";1))) //4 karakter nagybetű?
var csoport3 = Not(ISERROR(VALUE(MID([Minta];5;8)))) //5-12 karakterek számok?
var csoport4 = Not(ISERROR(SEARCH(UPPER(MID([Minta];13;1));"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";1))) //13 karakter helyes?
var csoport5 = Not(ISERROR(VALUE(MID([Minta];14;7)))) //14-20 karakterek számok?
var eredmeny = hossz * csoport1 * csoport2 * csoport3 * csoport4 * csoport5
return if(eredmeny;1;blank())[Minta] helyére írd be a nálad használt tábla+mezőnevet. A végén üres értéket adok vissza hibásakra, mert akkor egyből elrejti a Power BI a helytelen értékeket, de ha látni akarod és szűrni, akkor "return eredmeny" a vége.
üdv
-
Delila_1
veterán
válasz
eszgé100
#50665
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
Dim b As Integer
If Target.Column >= 5 And Target.Column <= 8 And Target.Row = 25 Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column).Font.ColorIndex = 1
For b = 1 To Len(Cells(Target.Row, Target.Column))
If Mid(Cells(Target.Row, Target.Column), b, 4) = "True" Then Cells(Target.Row, Target.Column).Characters(Start:=b, Length:=4).Font.ColorIndex = 4
If Mid(Cells(Target.Row, Target.Column), b, 5) = "False" Then Cells(Target.Row, Target.Column).Characters(Start:=b, Length:=5).Font.ColorIndex = 3
Next
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
válasz
eszgé100
#50643
üzenetére
Az újra színezés előtt vissza kell állítani egységes színűre a cella karaktereit.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim b As Integer
If Target.Column = 5 Then
Application.EnableEvents = False
Cells(Target.Row, 5).Font.ColorIndex = 1
For b = 1 To Len(Cells(Target.Row, 5))
If Mid(Cells(Target.Row, 5), b, 4) = "True" Then Cells(Target.Row, 5).Characters(Start:=b, Length:=4).Font.ColorIndex = 4
If Mid(Cells(Target.Row, 5), b, 5) = "False" Then Cells(Target.Row, 5).Characters(Start:=b, Length:=5).Font.ColorIndex = 3
Next
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
válasz
eszgé100
#50615
üzenetére
Az E oszlopodra:
Sub Zold_Piros()
Dim sor As Long, usor As Long, kezd As Integer, hossz As Integer
usor = Range("E" & Rows.Count).End(xlUp).Row
For sor = 1 To usor
If Right(Cells(sor, "E"), 4) = "true" Then
hossz = 4
kezd = InStr(Cells(sor, "E"), "true")
Cells(sor, "E").Characters(Start:=kezd, Length:=hossz).Font.ColorIndex = 4
Else
hossz = 5
kezd = InStr(Cells(sor, "E"), "false")
Cells(sor, "E").Characters(Start:=kezd, Length:=hossz).Font.ColorIndex = 3
End If
Next
End SubLusta voltam a nagybetűre váltást bele venni, majd kiigazítod.
-
Fferi50
Topikgazda
válasz
eszgé100
#50380
üzenetére
Szia!
Pontosan milyen feltételeknek kell megegyezniük ahhoz, hogy TRUE legyen az eredmény?
Miért van az, hogy a második képen a MODEL1SUB2_2_3 első sorában FALSE van, a második előforduláskor pedig TRUE?
A második táblázat hogyan keletkezik?
Mivel az első táblában "hiányos" az információ - csak annyit tudunk, hogy mennyi a Batch Size, azaz hány sornak kellene minimum lennie a második táblában, ezért szerintem makró kell majd hozzá.
De pontosan kellene ismerni a feltételeket, mit mivel kell hasonlítani - ahogyan az első kérdésemben írtam.
Üdv. -
eszgé100
őstag
válasz
eszgé100
#50198
üzenetére
Sziasztok!
Korábbi kérdésemből csak az "adott pötty fölé viszem az egeret, akkor megjelenítse a szériaszámot" maradt aktuális
Megoldható, hogy a Point "18/01/2023" helyett egy másik cella értéke legyen megjelenítve, pl C1-ben -37 van, viszont kellene a hozzá tartozó B1?
Másik újabb kérdésem a scatter plot charttal kapcsolatban, hogy meg lehet oldani, hogy a x tengely Dátum az adott tárgyhó 1-től induljon és tárgyhó végével érjen véget? Automatikusan Excel kiterjeszti a tengelyt mindkét irányba, hiába nincs semmilyen adat y-tengelyen megjelenítve. Kézzel meg tudom oldani, de ezt minden hónapban el kellene játszni, jobb lenne automatikus megoldás.
-
Fferi50
Topikgazda
válasz
eszgé100
#50137
üzenetére
Szia!
Úgy tűnik, hogy a SaveCopyAs nem szereti, ha a fájlt a hálózatra szeretnénk felmásolni. Valószínűleg egy jó kis bug. Jelezni kellene Redmond felé.
Megkerülő megoldás:
Megjegyzed a fájl nevét és elérési útját egy változóban.
Ezután SaveAs a fájlt a hálózatra, majd ismét SaveAs a változóban eltárolt paraméterekkel. Így visszajutsz az eredeti fájlodhoz. Szomorú, tudom, de legalább működik.
Üdv. -
eszgé100
őstag
válasz
eszgé100
#50096
üzenetére
megtalaltam mi a hiba, viszont igy egy masik kerdes merult fel.
F, G, H oszlopban felteteles formazas van ervenyben, 0 eseten a betu es hatter szine feher, ami jo is addig amig a Customert es a Commodity-t ki nem valasztom egy legordulo listabol. Ekkorra az index formulak eredmenye mar nem 0, szoval a felteteles formazasnak el kellene tunnie, de a feher betuszin nem valtozik meg valamiert, tudtok erre valami magyarazatot? -
lappy
őstag
válasz
eszgé100
#50065
üzenetére
Sub TwoFonts2()
Dim MyPos, SearchChar
SearchChar = "."
Range("B2").Select
With ActiveCell.Characters(Start:=5, Length:=1).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With ActiveCell.Characters(Start:=8, Length:=3).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub -
#48469
Fire/SOUL/CD
félisten
eszgé100
#48468
válasz
eszgé100
#48468
üzenetére
1. Az mindegy, hogy hol található (helyi/hálózati) a fájl, a 70-es kód ugyanaz, hozzáférés megtagadva (Permission denied)
2. Kérdésedben ott a válasz is, mert olvasásra kell megnyitni a fájlt, csak Te nem úgy nyitottad meg. A Workbooks.Open method (Excel)
A 3. paramétert kell igazra állítani, és akkor read-only-ban próbálja megnyitni, plWorkbooks.Open "c:\ubul\ubul.xlsx", , True -
Fferi50
Topikgazda
válasz
eszgé100
#48082
üzenetére
Szia!
Szerintem majdnem minden tanfolyamra elmondhatja valaki, hogy semmit sem ért....
Ha nem érintette azokat a témákat, ami őt érdekli, esetleg sok olyan dolog volt benne, ami neki már a kisujjában van stb.
Ezért azt javaslom, célratörően, a téged legjobban érdeklő témákban (függvényekben) nézz körül először az Excel Helpjében, aztán vagy azzal párhuzamosan a neten. Rengeteg példát, ismertetőt fogsz találni.
Olyan nincs, hogy részt veszel 1 db tanfolyamon és a kezedben lesz az Excel bölcsek köve.
Eredeti felvetésedhez kiegészítésként még annyit, hogy fontos a probléma megfogalmazása, ezután a kapcsolódó "modell" megalkotása majd ezután jöhet az Excel szerintem. Kérdés, mit szeretnél a befektetéseidről látni a táblázatban...
Üdv. -
-
Fferi50
Topikgazda
válasz
eszgé100
#47923
üzenetére
Ha jól látom, akkor a manualcheck változód a ciklus során nem változik, illetve a manual "Yes" esetén True lesz. Ez ugye szűrésnél rendben is van, de ha nincs szűrés, akkor egyetlen kézi ellenőrzésre szoruló tábla is megakasztja az összes többi bezárását is.
Ha jól gondolom, akkor a szűrés nélküli állapotban meg kellene vizsgálni, hogy az adott fájlhoz tartozik-e olyan sor, amelyben kézimunka szüksége.
Ezt a Countifs függvénnyel lehet megnézni szerintem, első feltétel a fájl neve a D oszlopon, második feltétel a yes a Manual Update oszlopon. Ha ez nem 0, akkor nem lehet a fájlt bezárni.
Üdv. -
Fferi50
Topikgazda
válasz
eszgé100
#47923
üzenetére
Szia!
Szerintem először nézd meg a Manual Update értékét.If Not manualcheck Then
Set scrange=ws.UsedRange.Columns("D").SpecialCells(xlCellTypeVisible).Find(what:=sPath, after:=Range("D" & counter))
If scrange.Row <= counter Then Excel.Workbooks(fileName).Close SaveChanges:=True
End If
Sőt, tulajdonképpen a keresési eredményt közvetlenül is lehet használni:If ws.UsedRange.Columns("D").SpecialCells(xlCellTypeVisible).Find(what:=sPath, after:=Range("D" & counter)).Row <= counter Then Excel.Workbooks(fileName).Close SaveChanges:=True
mivel legalább az adott sorban levő tételt meg fogja találni, tehát hibát nem okozhat a találat hiánya.
Üdv. -
Fferi50
Topikgazda
válasz
eszgé100
#47915
üzenetére
Szia!
1.)"a ciklus későbbi lépéseiben még szükség lesz rájuk, pl amikor egy workbookban van 20 worksheet, de nem egyszerre ömlesztve akarom őket kinyomtatni,"
ugyanakkor a ciklusban minden sornál ott van a Workbooks.Open, anélkül, hogy megnéznéd, nincs-e már megnyitva az adott file.
"mert utána akkor még kézzel is le kell válogatnom később"
másrészt, ha egy következő file másik munkalapját nyomtatod utána, akkor nem kell kézzel leválogatni az előzőtől?
2.a) szerintem alapvetően akkor van szükség GoTo utasításra, ha a makró/folyamat rosszul van megtervezve, megszervezve. Az ugrálás rontja az áttekinthetőséget és szerintem lassítja is a végrehajtást. Egy esetben látom indokoltnak, a futási hibák kezelésénél, ott ahol a hiba természete miatt külön hibakezelési rutinra van szükség az adott makrón belül. (Lásd: On Error Goto .. utasítás ).
2.b) Mod funkció -> egy osztás maradék eredményét adja vissza. Nálad azért 1 a feltétel értéke, mert mindig az adott ciklus utáni első hónapban nyomtatod a munkafüzetet (vagy ha úgy jobban tetszik, a ciklus első hónapjában). 3 havonta esetén az 1,4,7,10 hónapban. De mondhatnád azt is, hogy a 3,6,9,12 hónapban akarod nyomtatni, akkor a 0 maradék lenne a feltétel. Tehát te döntöd el, melyik hónapban kezdődjön a nyomtatási ciklus és a maradékot annak megfelelően használod feltételnek. Ugyanez igaz a többi ciklikus feltételre is.
3.a) Hibakezelésen tehát a felhasználói hibák vizsgálatát érted (amivel egyrészt megelőzheted fals adatok dokumentálását, másrészt program futási hibák keletkezését). Azt gondolom, erre az esetre érdemes egy külön függvényt írni, ami megizsgálja a kritikus összefüggéseket és logikai értéket ad vissza a vizsgálat eredményéről, amitől függően megy tovább a ciklus vagy elengedi azt a munkafüzetet/lapot.
Érdemes ettől függően azon is gondolkodni, hogyan kezeljük a futás idejű hibákat, mivel nem szeretnénk, ha ezek miatt utólag kellene a felhasználókkal hibát javíttatni.
3.b) Szűrés esetén a Darabteli függvény nincs tekintettel a szűrt állapotra valóban. Ebben az esetben a Save&close cella tartalma helyett meg kell nézned a szűrt területet makróval.
A D oszlop szűrt tartományát a következőképpen kapod meg:ActiveSheet.UsedRange.Columns("D").SpecialCells (xlCellTypeVisible)
A Find metódussal meghatározhatod a keresett érték helyét.Dim scrange As Range
Majd a nyomtatás után:Set scrange=ActiveSheet.UsedRange.Columns("D").SpecialCells (xlCellTypeVisible).Find(what:=sPath,after:=Range("D" & counter))If scrange.Row<=counter then --- save & close
Mivel nincs további találalat a szűrt tartományban, ezért az első találatra fog visszaugrani.
Üdv. -
Fferi50
Topikgazda
válasz
eszgé100
#47881
üzenetére
Szia!
Apróságokat tennék hozzá, talán gyorsít valamit rajta:
1. Kérdés: ahol Save&Close =no ott nem kell bezárni a fájlt? Mert ebben az esetben sok-sok fájlod nyitva fog maradni.
Ha mégis be kell zárni, akkorIf CStr(saveandclose) = "yes" Then
Excel.Workbooks(fileName).Close SaveChanges:=True
Else: GoTo nextraw
End If
helyett javaslom:Excel.Workbooks(fileName).Close SaveChanges:= CStr(saveandclose) = "yes"
Ha nyitva kell hagyni, akkor is elég az IF-es sor a következőképpen:If CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
Nem kell hozzá ELSE és END IF.
2. Javaslat: én nagyon nem szeretem az ugrálást makrón belül, általában mindig meg lehet oldani e nélkül a feladatot. Nálad 2 cimke van: openworksheets és nextraw.
Egy új változó bevezetésével el lehet kerülni a cimkéhez ugrást.
Dim nyomtatni As Boolean
Ennek a változónak adunk értéket a Select Case utasításokon belül - ezt is egy picit egyszerűsítve:Select Case CStr(freq)
Case "4 weekly", "monthly"
nyomtatni = True
Case "2 monthly"
nyomtatni = Month(nextmonth) Mod 2 = 1
Case "3 monthly"
nyomtatni = Month(nextmonth) Mod 3 = 1
End Select
A két cimke helyére pedig:openworksheets: helyett:
If nyomtatni Then
.
.
nextraw: helyett
End If
Áttekinthetőbb és szerintem gyorsabb is lehet.
3. Kérdés:
Milyen szűrést szeretnél? Hol lenne helye a hibakezelésnek?Üdv.
-
Delila_1
veterán
válasz
eszgé100
#47881
üzenetére
Gyorsíthatod a futást, ha nem állsz rá lépten-nyomon egyes cellákra. 5 ilyen feltételt láttam.
If CStr(dat) <> "" ThenSheets(ssheet).SelectRange(dat).SelectActiveCell.Formula = sDateEnd Ifhelyett írd ezt
If CStr(dat) <> "" Then Sheets(ssheet).Range(dat).Formula = sDate -
Pakliman
tag
válasz
eszgé100
#47878
üzenetére
Szia!
Egy ilyen kódot találtam.
Nem tudom, műxik-e, nem próbáltam
Van benne egyJobsDesc(lThisJob).pDocumentsor a For .. Next ciklusban, talán a nyomtatandó file neve.(A saját programomban rákérdezek, hogy sikerült-e nyomtatás és csak azután megyek tovább. Bár nálam a nyomtatott dokumentum megléte és minősége a lényeg.)
Találtam mégy egyet, ami talán egy kicsit egyszerűbb(en átalakítható a Számodra).
-
-
#47755
Fire/SOUL/CD
félisten
eszgé100
#47751
válasz
eszgé100
#47751
üzenetére
C3
=HA(HÉT.NAPJA(B3)=2;B3;B3+(7-HÉT.NAPJA(B3;2)+1))=IF(WEEKDAY(B3)=2,B3,B3+(7-WEEKDAY(B3,2)+1))D3
=C3+28E3
=ISO.HÉT.SZÁMA(HA(HÉT.NAPJA(B3)=2;B3+28;(B3+(7-HÉT.NAPJA(B3;2)+1))+28))=ISOWEEKNUM(IF(WEEKDAY(B3)=2,B3+28,(B3+(7-WEEKDAY(B3,2)+1))+28))Már, ha jól értettem a feladatot (ha nem, akkor is így marad)
-
Fferi50
Topikgazda
válasz
eszgé100
#47751
üzenetére
Szia!
Több lehetőség is van. A képen látható elrendezés esetén E2 képlete:=MAX(ROUNDUP(ISOWEEKNUM(D2)/4,0)*4,ISOWEEKNUM(D2))*7+C2
Másik ötletem:
Az év elején (vagy akár most) felrakod egy segéd táblázatba a negyedik hétfőket:
Ne kavarjunk bele, legyen I2=C2, majd I3 képlete =I2+28
Lehúzod, ameddig szükséges, majd az így létrejött képletes részt átalakítod értékké (másolás, irányított beillesztés értéket) - csak a biztonság kedvéért, nehogy megváltozzon valami miatt. Akár el is nevezheted a táblázatot.
Ezután az E2 képlete:=IFERROR(VLOOKUP(D2,$I$1:$I$29,1,0),INDEX($I$1:$I$29,MATCH(D2,$I$1:$I$29,1)+1))
Üdv. -
Fferi50
Topikgazda
válasz
eszgé100
#47746
üzenetére
Szia!
Nézetem szerint az alábbi módon lehetne megoldani a problémát:
A1 cellában van a január 1.
B1 cellában van meghatározva az év első hétfője, ezzel a képlettel:=HA(HÉT.NAPJA(A1;2)>=5;A1+8-HÉT.NAPJA(A1+7;2);A1-HÉT.NAPJA(A1;2)+1)
Ezek után a megfelelő hétfő meghatározása szerintem már egyszerű, csak az első hétfőhöz hozzá kell adni a kívánt hét számát 7-tel szorozva.
Remélem ezzel tudtam segíteni.
Az ISOWEEKNUM függvény és a mai dátum csak illusztráció. Ha tudjuk hanyadik hétről van szó, akkor elég azzzal szorozni.
Üdv. -
#47708
Fire/SOUL/CD
félisten
eszgé100
#47707
-
#47705
Fire/SOUL/CD
félisten
eszgé100
#47702
válasz
eszgé100
#47702
üzenetére
Az elv, amit felvázoltál, az rendben van, csak korábban 2 telepített hálózati nyomtatóról volt szó, az meg nem látszódik a listában, pedig kellene (nálad biztosan nincs telepítve ez a 2 nyomtató)
-
#47661
Fire/SOUL/CD
félisten
eszgé100
#47660
válasz
eszgé100
#47660
üzenetére
A megoldást már más megírta, úgy hogy csak INNEN bemásolom a kódot.
Annyi módosítást hajtottam csak végre a kódban, hogy a 3 db privát funkció deklarációban beleírtam a PtrSafe tulajdonságot, mivel enélkül 64 bites rendszer alatt nem futna le a kód.Module1-be kerülő kód:
Option Explicit
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" ( _
ByVal HKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" ( _
ByVal HKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Byte, _
lpcbData As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
ByVal HKey As Long) As Long
Public Function GetPrinterFullNames() As String()
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long ' index into Printers()
Dim HKey As Long ' registry key handle
Dim Res As Long ' result of API calls
Dim Ndx As Long ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long ' length of ValueName
Dim DataType As Long ' registry value data type
Dim ValueValue() As Byte ' byte array of registry value value
Dim ValueValueS As String ' ValueValue converted to String
Dim CommaPos As Long ' position of comma character in ValueValue
Dim ColonPos As Long ' position of colon character in ValueValue
Dim M As Long ' string index
' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)
' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
M = InStr(1, ValueName, Chr(0))
If M > 1 Then
' clean up the ValueName
ValueName = Left(ValueName, M - 1)
End If
' find position of a comma and colon in the port name
CommaPos = InStr(1, ValueValue, ",")
ColonPos = InStr(1, ValueValue, ":")
' ValueValue byte array to ValueValueS string
On Error Resume Next
ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
On Error GoTo 0
' next slot in Printers
PNdx = PNdx + 1
Printers(PNdx) = ValueName & " on " & ValueValueS
' reset some variables
ValueName = String(255, Chr(0))
ValueNameLen = 255
ReDim ValueValue(0 To 999)
ValueValueS = vbNullString
' tell RegEnumValue to get the next registry value
Ndx = Ndx + 1
' get the next printer
Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
0&, DataType, ValueValue(0), 1000)
' test for error
If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
Exit Do
End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
' Return the result array
GetPrinterFullNames = Printers
End Function
Sub Test()
Dim Printers() As String
Dim N As Long
Dim S As String
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
S = S & Printers(N) & vbNewLine
Next N
MsgBox S, vbOKOnly, "Printers"
End SubEredménye (most az Én gépemen futtatva)
Nyilván esetedben annyiban kell módosítani pluszban a kódot, hogy ne a képernyőre irogassa ki az összes nyomtatót, hanem a cikluson belül, megvizsgálod, hogy az aktuális printer neve tratalmazza-e az általad használt 2 printer nevének egyikét, ha igen, akkor "elévarázsololod" a \\ jelet és a megfelelő változódnak meg is van az értéke és kb. meg is vagy.
-
#45148
Fire/SOUL/CD
félisten
eszgé100
#45147
válasz
eszgé100
#45147
üzenetére
Óóóó, bakker, ezt Én nagyon félreértettem. nagyon másra gondoltam...
Akkor ennyi az egész.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'itt adhatod meg, hogy mely tartományban lévő cellákon működjön a duplaklikk
'itt a példában az A1:A5 tartományt vizsgálja
If Not Intersect(Target, Range("A1:A5")) Is Nothing Then
Select Case Target.Value
Case 0
ActiveCell.Value = 25
Case 25
ActiveCell.Value = 50
Case 50
ActiveCell.Value = 75
Case 75
ActiveCell.Value = 100
Case 100
ActiveCell.Value = 0
End Select
'ez a kis "trükk" oldja meg, hogy nem lép be a cellába szerkesztési üzemmódba
Cancel = True
End If
End Sub -
#45138
Fire/SOUL/CD
félisten
eszgé100
#45135
-
Fferi50
Topikgazda
válasz
eszgé100
#44552
üzenetére
Szia!
A CreateObject egy új Excel példány hoz létre, ami teljesen szükségtelen.
"így megsprórolom a fájlok külön megnyitogatását is, ugye?"
Ezt nem gondolnám, mert hogyan tudná akkor beállítani a megfelelő értékeket a nyomtatáshoz? Kívülről ez nem megy.
Viszont nem kell minden fájlba beírni a makrókat, elég a "főfájlba betenni", ott pedig a makróban a beállításokat igazíthatod az éppen nyomtatni kívánt dokumentumhoz pl. a neve alapján. Tehát ez az egy makró szépen megnyitogatja amit kell, beállítja amit kell és kinyomtatja ahogyan kell. Azt is meg lehet vizsgálni, hogy melyik területen nyitották meg és ahhoz igazítani a nyomtatandó/nyomtatható fájlok listáját.
Üdv. -
Fferi50
Topikgazda
válasz
eszgé100
#44542
üzenetére
Szia!
Azért lenne pár kérdésem ez alapján.
Először a makrókhoz:
Dokumentumokról beszélsz, ezek Excel vagy Word fájlok?Sub Open_Word_Document()Set objWord = CreateObject("Word.Application")objWord.Documents.Open "Z:\Excel\ALBÉRLET.docm"objWord.Visible = FalseobjWord.Application.Run "NewMacros.toprint"CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:01"))objWord.Quit SaveChanges:=objWordsDoNotSaveChangesSet objWord = NothingEnd Sub
Itt megnyitsz egy Word alkalmazást és abban egy dokumentumot, majd lefuttatsz egy makrót, ami a Word alkalmazásban (NewMacros) van, ami kinyomtatja azt. Ezután létrehozol egy Excel alkalmazást és bezárod a Word-ot.
Ha Excelből indítod a makrót, akkor miért kell új Excel alkalmazás létrehozni? Ha Wordben van a makró, akkor miért kell új Word alkalmazást létrehozni, majd bezárni?
Nem tudom hány xls-ed van, de nem hiszem, hogy mindegyiket külön-külön el kellene látni ugyanazon funkciókat végző makrókkal. Én egy alap Excelt használnék, amiben a makrók benne vannak és abból intézném az összes többinek a megnyitását és kezelését. Így csak egy fájlt kell karbantartani, nem pedig x db-ot.
De lehet, hogy rosszul látom.
Üdv. -
eszgé100
őstag
válasz
eszgé100
#44488
üzenetére
vetne erre valaki egy pillantást?
fenti problémát szeretném még mindig megoldani, a változókat szépen összelinkelem egy dokumentumból, valamint ugyanebben a dokumentumban elhelyezek egy Gombot, ami lefuttat valami hasonlót:
Sub Open_Word_Document()Set objWord = CreateObject("Word.Application")objWord.Documents.Open "Z:\Excel\ALBÉRLET.docm"objWord.Visible = FalseobjWord.Application.Run "NewMacros.toprint"CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:01"))objWord.Quit SaveChanges:=objWordsDoNotSaveChangesSet objWord = NothingEnd SubA word doksiban pedig lefutnak ezek a makrók:
Sub kicsi()'' kicsi Macro''Selection.WholeStorySelection.Font.Size = 10End SubSub toprint()'' toprint Macro''Dim strCurrentPrinter As StringstrCurrentPrinter = Application.ActivePrinterApplication.Run MacroName:="kicsi"Application.ActivePrinter = "HPFDDA3F (HP Photosmart C4500 series)"Application.PrintOut Range:=wdPrintAllDocument, Copies:=1Application.ActivePrinter = strCurrentPrinterEnd SubTermészetesen csak egy példa, ami nagyjából azt demonstrálja, hogy egy gombnyomásra a háttérben megnyíljon a Word/Excel, lefuttasson adott makrókat majd azt egy megadott nyomtatóra elküldje, és mentés nélkül zárja be.
Ezen kívül kell még szerintetek nekem valami, mielőtt nekiállok linkelni a doksikat és nagyüzemben makrókat írni hozzájuk?
Ezután a Dátum oszlopra az adattípus módosításánál kiválasztod a tizedes törtet.
Elvileg ebben az esetben a dátumok számmá változnak. Utána pedig visszaállíthatod dátum formátumúra.
Új hozzászólás Aktív témák
Fferi50- Miért vezet mindenki úgy, mint egy állat?
- Hamarosan megjön az ASUS házak új zászlóshajója
- Formula-1
- sziku69: Szólánc.
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Redmi Note 14 5G - jól sikerült az alapmodell
- Elektromos autók - motorok
- Milyen videókártyát?
- TCL LCD és LED TV-k
- PlayStation 5
- További aktív témák...
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Eladó Steam kulcsok kedvező áron!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- 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.
- Telefon felvásárlás!! Apple iPhone SE (2016), Apple iPhone SE2 (2020), Apple iPhone SE3 (2022)
- BESZÁMÍTÁS! ASRock B550M R5 5600 32GB DDR4 512GB SSD RTX 4060 TI 16GB Zalman N5 Chieftec 700W
- Intel X540-T2 dual-port 10GbE RJ45 hálózati vezérlő (10Gbit, 2 port, áfás számla, garancia)
- BESZÁMÍTÁS! Apple iPhone 16 Pro MAX 256GB okostelefon garanciával hibátlan működéssel
- MSI Z77 MPOWER Alaplap eladó
Állásajánlatok
Cég: FOTC
Város: Budapest