- iPhone topik
- Xiaomi 13 - felnőni nehéz
- Honor 200 Pro - mobilportré
- Szívós, szép és kitartó az új OnePlus óra
- Xiaomi 15 - kicsi telefon nagy energiával
- Fotók, videók mobillal
- Android alkalmazások - szoftver kibeszélő topik
- Apple iPhone 16 Pro - rutinvizsga
- Keretmentesít a Galaxy S25 FE
- Magyarországon is kapható a Moto G85 5G
-
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
-
Gem Geza
csendes tag
válasz
Fferi50
#27281
üzenetére
Hali,
Próbálkozok-próbálkozok, de csak nem akar összejönni. A kézi formázás nem járja, túl sok munka lenne vele. Készítettem egy magyarázó táblát
.
Az X tengelyen a Fő egységeket jeleníteném meg, az Y tengelyen a hónap napjait (+1 nap áthozat), a Z tengelyen a fő egységen belüli mérési pontokat.
Az oszlop az adott napnak megfelelő színt venné fel. 1 nap esetén 1x1x1-es kocka rajzolódnak ki azon a színen, ami az adott napnak megfelel.
Ha jól gondolom ez 32 diagram in 1 diagram.A makrót nehéz megtanulni? Sajna abban teljesen süket vagyok.
Köszi GG
-
-
Gem Geza
csendes tag
válasz
Fferi50
#27253
üzenetére
Hali,
Köszi a válaszod, lehet kicsit körülményes vagyok, mert a feladat sem tiszta még és kicsit bonyolultnak tűnik.
Szóval a lényeg: Van egy 32 munkalapból (hónap napjai + áthozat) álló táblázat, amiben 4 oszlopban 60 sorban találhatóak az adatok. Ezekből a táblákból egy függvény olyan végeredményt generál aminek az értéke a következő: zöld, sárga, piros, fekete. Minden munkalapra elvégződik ez a vizsgálat és minden munkalapon ua-a helyen meglesz az eredménye. Ezekből az eredményekből kellene egy olyan 3D-s 4 soros, 60 oszlopos diagramot létrehozni, aminek az oszlopai az adott értéknek felelnek meg.
Ha jól csinálnám akkor egy olyan oszlopdiagramot kaphatnék, ami 240db akár 4 színben megjelenő oszlopokat fog tartalmazni.Az általad említett cella függvény sajnos nem működik. Legalábbis nekem nem sikerült vele dűlőre jutnom.A függvényemet nem sikerült beletennem.
Segítségedet előre is köszi
GG -
azopi74
addikt
válasz
Fferi50
#27255
üzenetére
"Viszont azt nem tudom, hogy a Google Drive-on levő excelben működnek-e a makrók."
Nem működnek VBA makrók Google Docs-ban. Még a Microsoft féle Excel Online-ban sem, nemhogy a Google Sheets-ben.
Google Sheets-hez Google Apps Script érhető el, de az jelenleg még eléggé korlátolt a VBA-hoz képest, olyan szinten sincs, mint az Office 2013-tel bemutatkozott Apps for Office/NAPA (ami egyébként elérhető Excel Online-on és Excel universal app-on is, és Androidos és iOS-es Excelen is talán) -
#27250
dellfanboy
őstag
Fferi50
#27249
-
Declare
őstag
válasz
Fferi50
#27240
üzenetére
Ezt a programkod gombot soha nem hasznaltam, sorry. Sehol mashol nem irtam meg "programkodot" csak itt
legközelebb figyelek ra!Nem kicsit vagy jo, ezekböl igy összerakni latatlanba, mit büveszkedtem
es valoban ez a szitu.En mindig ugy irtam meg ezeket a függvenyeket, hogy ha "ne csinaljon semmit" akartam eredmenyül kapni, akkor szoközt raktam az idezöjelek köze (" "). Egesz egyszerüen azert, mert sok soros kepleteim vannak, amiket huzok jobbra, balra es ezekre mas kepletek hivatkoznak. Ha pl egy HA fv. eredmenye ez: " " akkor a ra hivatkozo keplet (pl egy FKERES) ennel a sornal siman csak nem csinal semmit. Ha viszont ezt: "" adna a HA fv. akkor az FKERES ezt adna eredmenyül ennel a sornal => #NV .
Innentöl viszont borulna az összes többi kepletem, szumma stb.
Jogos, hogy ez igy visszüthet ilyen esetben.
Ezek alapjan rossz ahogy csinalom es van valami banalisan egyszerü megoldas a fenti problemamra, vagy ha ilyen több egymasra hivatkozo kepletem van, akkor ez a jo megoldas, ahogy csinaltam?
-
Declare
őstag
válasz
Fferi50
#27232
üzenetére
Igen sor szamot
Sub prob()
Dim LastLine As Long
LastLine = Columns(1).Find("*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).Row
Range("A353
" & LastLine).SelectEnd Sub
Ez nem müködik
Kijelöli ugyan ugy az egesz tablat, ameddig be van kepletezve, nem csak addig amig erteket ad a keplet.Ha van ötlet, miert, vagy valamit rosszul csinaltam, arra kivancsi vagyok, de igazabol, amit irtal elsö verzionak azzal tökeletesen megoldottam, amit szerettem volna
-
Declare
őstag
válasz
Fferi50
#27142
üzenetére
Neztem, de azt nem igazan tudom, hogy kellene müködesre birnom
ha megmutatjatok, megköszönöm es megnezem Dim LastLine As Long
LastLine = Columns(1).Find("*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).RowA353 tol kellene FX ig kijelölni a területet. Hogy tudom ezt a fenti sorok utan megtenni?
A (#27128) Fferi50 HSZ-edben amit irtal, viszont tökeletesen müködik
annyi, hogy egy szoközt be kellett tennem a ket " köze Do While utcell.value = ""
-
csadi0011
őstag
válasz
Fferi50
#27219
üzenetére
Köszönöm neked is.@karlkani:
Akkor (KEREK.LE(A1;-1) lett volna a függvényben ![;]](//cdn.rios.hu/dl/s/v1.gif)
Amúgy az Adventure Capitalism nevű játékhoz csinálok egy gyors számolót, amibe beírom, hogy mennyi pénzre van szükségem és a profitomból kiszámolja, hogy mennyi idő alatt jön össze.Raktam bele napot az óra, perc, másodperc elé a kerek.le függvényes változattal. és úgy néz ki, hogy B1 cellában van a profit, hogy mennyi a bevétel másodpercenként. E1 cellába írod, hogy mennyi az a pénz aminek tudni akarod az összegyűlési idejét. G1 cellában pedig a fantasztikus függvény, amit meg is untam mert ilyen hosszú lett:
=HA((E1/(B1*3600))>=24;(KEREK.LE(E1/(B1*3600)/24;0)*1000000+KEREK.LE(E1/(B1*3600)-KEREK.LE(E1/(B1*3600)/24;0)*24;0)*10000+(KEREK.LE(HA((1-(KEREK.FEL((E1/(B1*3600))-KEREK.LE(E1/(B1*3600)/24;0)*24; 0)-((E1/(B1*3600))-KEREK.LE((E1/(B1*3600))/24;0)*24)))=1;"00";(1-(KEREK.FEL((E1/(B1*3600))-KEREK.LE((E1/(B1*3600))/24;0)*24; 0)-((E1/(B1*3600))-KEREK.LE((E1/(B1*3600))/24;0)*24)))*60);0))*100+(KEREK.LE(HA((1-((KEREK.FEL(HA((1-((KEREK.FEL((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24); 0))-((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24))))=1;"00";(1-((KEREK.FEL((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24); 0))-((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24))))*60);0))-(HA((1-((KEREK.FEL((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24); 0))-((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24))))=1;"00";(1-((KEREK.FEL((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24); 0))-((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24))))*60))))=1;"00";(1-((KEREK.FEL(HA((1-((KEREK.FEL((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24); 0))-((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24))))=1;"00";(1-((KEREK.FEL((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24); 0))-((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24))))*60);0))-(HA((1-((KEREK.FEL((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24); 0))-((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24))))=1;"00";(1-((KEREK.FEL((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24); 0))-((E1/(B1*3600))-(KEREK.LE((E1/(B1*3600))/24;0)*24))))*60))))*60);0)));KEREK.LE((E1/(B1*3600));0)*10000+KEREK.LE((HA((1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))=1;"00";(1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))*60));0)*100+KEREK.LE((HA((1-((KEREK.FEL((HA((1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))=1;"00";(1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))*60));0))-(HA((1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))=1;"00";(1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))*60))))=1;"00";(1-((KEREK.FEL((HA((1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))=1;"00";(1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))*60));0))-(HA((1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))=1;"00";(1-(KEREK.FEL(E1/(B1*3600); 0)-E1/(B1*3600)))*60))))*60));0))
-
#27185
szabonagyur
félisten
Fferi50
#27184
szabonagyur
félisten
válasz
Fferi50
#27184
üzenetére
Tényleg ott van, köszönöm szépen
Van egy ritkán használt gépem amin néha dolgozgatok kint az udvaron, arra még jó... és már az O365 licenszből nincs több szabadon, csak a 2010-ből aztán gondoltam felrakom arra, arra még jó, csak ezt nem találtam benne Van amúgy valami olyan ami nincs benne az Excel 2010-ben de a 2013-ban és must have?
2013-ban vannak ezek a áruház cuccok, stb de az nem érint engem.
-
azopi74
addikt
válasz
Fferi50
#27097
üzenetére
Én meg azt nem értem, hogy miért nem érhető el excelből (akár name managerből, akár natívan) az összes VBA-s függvény.
Pl egy JOIN is hiánypótló lenne, vacak CONCATENATE helyett. Meg van még egy pár.
Persze bizonyos szempontból érthető , de legalább lehetne mondjuk az excelt expert módba kapcsolni, és akkor minden jóság elérhető lenne, nem kéne makrózgatni minden vacakot, állítólag úgyis a hosszú távú stratégia, hogy a VBA-t örök vadászmezőkre küldjék, dehát így nehéz lesz...
-
-
karlkani
aktív tag
válasz
Fferi50
#27064
üzenetére
Szia!
Tudom, hogy csak egész számokat fogad el, de elütés esetén a számított mezőben #ÉRTÉK jelenik meg azonnal, mert számot betűvel, írásjellel, stb., nem tud szorozni (beírja, csak hibaüzenet jön fel és nem engedi, hogy ott maradjon). Viszont a SZORZAT képletet alkalmazva a sima =A1*B1 helyett, jó. Ugyan, ilyenkor a "nem szám" karaktert 1-nek veszi (mintha 1 db-ot írtam volna, ezért nincs összegzéskor hiba), de az érvényesítés úgyis jelzi, hogy baj van. Innentől kezdve nincs szükség lenyíló menüs listára, mert a módosítás dátumának helyén nem fog #ÉRTÉK megjelenni, amit csak a két rejtett oszlop felfedésével, majd az alábbi képletnél a szerkesztőlécre lépve, majd vissza a munkalapra (ctrl+alt+F9-re innél semmi sem történik).
=HA(C9="";"";HA(VAGY($E$9="";ÉS(SZÁM(F9);C9=F9));F9;C9)) -
karlkani
aktív tag
válasz
Fferi50
#27062
üzenetére
Szia!
Ezen a munkalapon 500-20000-ig vannak a papírcímletek, darabszám, érték összesen az adott bankjegyből, a címletek összértéke, valamint a módosítás ideje. Az idő körkörös hivatkozással lett megoldva, egy fórumtárs segítségével, ami szépen működik is. Viszont, ha nem számok kerülnek a darabszámos mezőkbe (véletlen elütöm), akkor a módosítás dátumára kapok egy #ÉRTÉK! hibaüzenetet. Emiatt kell legördülő lista, érvényesítésnél kellene forrásnak megadni 0-100-ig az egész számokat. Gondolom erre marad az, hogy egy oszlopban 0-100-ig elkészítem a cellákat, majd azt adom meg forrásnak, esetleg az oszlopot elrejtem...
Már át is szerkesztettem a képleteknél!
-
-
#27022
dellfanboy
őstag
Fferi50
#27015
dellfanboy
őstag
válasz
Fferi50
#27015
üzenetére
köszi++
az normális hogy ott nem tudok válaszolni?
szia
köszi a segítséget
2007-es az xls-em de ezt a napokban fogják updatelni.
mintát feltölteni nem tudok de leírok 1 példát
van 1 xls ügyfél adatokkal,név,id1,id2 ország,megye,város,F/L,kor
1másik hogy mit vett tőlünk(telco-it szolgáltatás) elég részletesen
harmadik hogy amit eladtunk neki az milyen főkönyvre van bekötveés ebből vannak summaryk hogy pl
mobil bevétel mennyi /ország/megye/város/kor bontásban a mobil bevételből mennyi az sms, internet stb. ha változott miért vett-e ilyen bővítő cuccot stb. -
-
Árnymester
tag
válasz
Fferi50
#26968
üzenetére
Köszi. Megvannak ezek a függvények. Ismerem ezeket. Egyébként 2010-ről van szó aktuálisan, de használok 2013-at is. A beépített függvények nem tudják a rendkívüli munkanapokat, és nekem most erre volt szükségem, csak nem jött az ötlet. Ha csak egy nap vizsgálatáról lett volna szó, simán leküzdöm FKERES-sel.
Delila szállította a megoldást.
Köszönöm a reflektálást. -
Vladek83
tag
válasz
Fferi50
#26933
üzenetére
A két oszlopban, előfordulhat azonos karakter és mind a két lehetőséget (amit írtál) kellene mutatnia. Mikor leüti a következő betűt vagy számot, akkor már csak azokat a sorokat mutassa ahol az a kettő karakter megtalálható... ( a kis és nagybetűt hagyja figyelmen kívül ) Remélem mindent leírtam
-
tombar
senior tag
-
Fferi50
Topikgazda
válasz
Fferi50
#26879
üzenetére
De még parancsgomb se kell, a makró indítást felteheted a menüszalagra a beállítások, menüszalag testreszabása használatával.
A makróhoz kellene egy kicsit pontosabb ismeret:
Pivottáblából csinálod a diagramot, vagy a "táblázatod" egyszerűen csak külső hivatkzásokat tartalmaz?Üdv.
-
Easy01
újonc
válasz
Fferi50
#26875
üzenetére
Szia!
Beállítottam a megnyitáskori frissítést. A felhasználó azt a személyt jelentené, aki megnyitja a táblát, az szűrni tud benne, valamint a diagramot tudja használni, de a cellákba nem tud sem írni, sem törölni. A tábla töltődik a hivatkozások által, frissülni pedig automatikusan frissül minden megnyitáskor. Viszont ha egész nap használja a felhasználó, folyamatosan nyitva van a file, akkor a napközbeni frissítést az adatok/kapcsolatok/összes frissítéssel oldanám meg, de ezt nem engedi a lapvédelem miatt. Így ezért kérdeztem, hogy esetleg van-e erre valamilyen egyéb megoldás
. Én csak egy lelkes excel felhasználó vagyok, a tudományom véges . Köszi a segítséget! -
Easy01
újonc
válasz
Fferi50
#26873
üzenetére
Szia! Nagyon köszönöm a választ
. Egy problémám van csak, hogy ez a tábla automatikusan és önállóan dolgozik, én nem is nyúlok bele csak a végfelhasználó. Ezért a feloldásra sincs lehetőség . A célom az lenne, hogy automatice frissítse az adatokat felhasználás céljából, de ne lehessen szerkeszteni a táblát. -
azopi74
addikt
válasz
Fferi50
#26851
üzenetére
Hát ritkán mondok ilyet, de ez tipikusan az a feladat, ahol sajnos muszáj lesz némi minimális VBA-t bevetni, ha segédoszlop nélkül akarjuk. Az a probléma, hogy ez a vacak concatenate "függvény" elég korlátozott, számomra érthetetlen módon nem lehet neki tömböt megadni paraméterként. Szóval szerintem valamennyi minimális VBA kód muszáj bele, mondjuk ennyi:
Function JoinAll(InputArray As Variant, delim As String) As String
JoinAll = Join(InputArray, delim)
End FunctionÉs akkor ezt rá lehet ereszteni a tömbképletedre, "delim"-nek olyan delimitert megadva, amit akarunk.
Dehát ha már van benne VBA kód, akkor már úgyis mindegy, veszett fejsze nyele
Más ötletem nagyon sajnos nincs, ha szövegösszefűzésről van szó, akkor én is a VBA-ra fanyalodok a primitív concatenate "függvény" - ami valójában nem más, mint az "&" operátor, csak függvény-szerű szintaktikába csomagolva - hiányosságai miatt (nem csak a tömböket, de például az iterációt se támogatja)...
Nem értem miért nem lehet a VBA-s join függvényt betenni a natív excel függvények közé. Ha betennék, akkor ez (meg egy csomó más probléma) teljesen VBA mentesen megoldható lenne.... -
#26789
TrollBalint
addikt
Fferi50
#26787
-
#26783
TrollBalint
addikt
Fferi50
#26782
TrollBalint
addikt
válasz
Fferi50
#26782
üzenetére
kézzel bővítem a táblázatot, egyelőre makró-mentes a file.
Ami még számomra érdekes, hogy mikor kijelöltem a kész tartományt, és táblázattá alakítottam, akkor tartalmazott X darab oszlopot. Azóta, ha új oszlopot szúrok bele (mindig a végére), akkor az eredetileg táblázattá alakított tartomány utolsó oszlopának a formátumát örökli.ja, és a sok formázástól, meg szeret meghalni a file is
Párszor belefutottam a hibába, hogy csinálgattam a dolgomat, elmentem, és mikor meg akarom nyitni, azt írta ki, hogy "file is corrupted" és nem is nyitotta meg. Mikor egy újabb excel-ben megnyitottam - mert hogy az meg tudta nyitni - akkor kiírta, hogy valami stílus probléma van az egyik táblázattal. Azt törölte, és egyébként működött minden. ha újra megformáztam ezt a táblázatot, akkor meg jó lett -
#26781
TrollBalint
addikt
Fferi50
#26780
TrollBalint
addikt
válasz
Fferi50
#26780
üzenetére
Ezt akkor buktam
(Merthogy nekem táblázattá alakított tartományom van, még azopi ajánlotta bő egy hónapja, és azt kell mondjam, nagyon megtetszett, tényleg hasznos. Erre a problémára meg akkor megpróbálok megoldást találni a neten.
Mindenesetre köszi a segítséget,azopi: Neked esetleg van ötleted a megoldásra?
-
#26779
TrollBalint
addikt
Fferi50
#26748
TrollBalint
addikt
válasz
Fferi50
#26748
üzenetére
Köszi,
Egy beállítást találtam:Extend data range formats and formulas Ez nálam be van pipálva (a help szerint, ha jól értem, ez lemásolja az előző sor formátumát. Ehhez képest nem működik
Jól sejtem, hogy ez(ek) a beállítás(ok) a file-hoz tartoznak és nem magához az Excelhez? Mert akkor megnyitom egy modernebb office-szal és beállítom ott -
csferke
senior tag
válasz
Fferi50
#26757
üzenetére
A Hyperlink.TextToDisplay tulajdonság értéke legyen a számlaszám.
Sajnos ezzel nem boldogulok. További segítségedet kérem.A "Számla készítése" lapon (hogy egy helyen legyen minden adat) van egy ilyen rész.
Egy gombhoz (Könyvelés) rendelt makróban Copy A2:E2, átváltás a "Számlák könyvelése" lapra, A oszlop utolsó bejegyzése sor+1 és itt Paste.
Csak ezután, egy másik gomb (PDfF írás & Nyomtatás) íródik ki a számla pdf-be a C4 mezőben összevont névvel és elküldi a számlát egy nyomtatóra is.Pdf írás előtt meghívódik ez a szubrutin amely meghatározza az írás helyét
Sub HovaMenteniMappa()
ChDrive "G"
ChDir "g:\valami\2015\"
End SubTehát azt szeretném, hogy a "Számla könyvelése" lapon a B oszlopban lévő számlaszámok egyben hivatkozások is legyenek az adott pdf számlához. Mindezt automatikusan a makró-ból.
Remélem érthetően sikerült megfogalmaznom az elképzelésemet.
köszi
-
azopi74
addikt
válasz
Fferi50
#26762
üzenetére
Ja persze, a cellaformátumot illek beállítani el.
Igen, megszerettem a használatát, sok helyen ütközik az ügyfél IT policyjával a makrók használata, és le van tiltva alapból, ilyenkor sokszor az iteratív kalkuláció engedélyezése életmentő lehet
Bár néha - komplexebb dolgoknál - kicsit sokat kell a megoldáson agyalni -
Mindless
tag
válasz
Fferi50
#26719
üzenetére
Szia!
Köszönöm a gyors válaszodat
=HA(G351="";"";INDEX(Keres!L:L;HOL.VAN(1;(Keres!G:G=G351)*(Keres!F:F=F351)*(Keres!E:E=E351);0)))
Szerinted ezt a 3 változóval kereső függvényt meg lehet fordítani, úgy hogy ugyanezt csinálja, csak mindig a táblázat aljáról kezdje vagy az utolsó találatot adja vissza az első helyett?
Köszi előre is
-
Zola007
veterán
válasz
Fferi50
#26708
üzenetére
Szia!
Köszönöm, de sajnos ez sem működik valamiért. ( Office Professional Plus 2010 egyébként)Igen, munkalap függvénynek akartam használni, hogy később is ha kijelölök még hozzá egy területet, azt is számolja bele, de akkor úgy látom tényleg minden tartományt külön paraméterként kell bekérni.
Kár, hogy nem tudja a makró kezelni ezt csak külön-külön definiálva.
Nem tudom hány sor vagy oszlop lesz később hozzáadva, inkább megcsinálom úgy, hogy simán összeadom az egyes függvények eredményét, pl így:
=SZUM(sumbold(F12:P12);sumbold(F21:P21);sumbold(F9:P9);
sumbold(F15:P15);sumbold(F18:P18);sumbold(F24:P24))és ha utólag kell még hozzádobni egy tartományt, akkor nem kell a makrót változtatni
-
-
zhari
csendes tag
válasz
Fferi50
#26648
üzenetére
Köszi.
Ezt találtam még a neten de nem akar működni a szerző és az tulaj bejegyzés kinyerése. Meg tudnátok nézni h mi baja lehet?
Előre is köszi
Option Explicit
Public x()
Public i As Long
Public objShell, objFolder, objFolderItem
Public FSO, oFolder, Fil
Sub MainExtractData()
Dim NewSht As Worksheet
Dim MainFolderName As String
Dim TimeLimit As Long, StartTime As Double
ReDim x(1 To 65536, 1 To 11)
Set objShell = CreateObject("Shell.Application")
TimeLimit = Application.InputBox("Please enter the maximum time that you wish this code to run for in minutes" & vbNewLine & vbNewLine & _
"Leave this at zero for unlimited runtime", "Time Check box", 0)
StartTime = Timer
Application.ScreenUpdating = False
MainFolderName = BrowseForFolder()
Set NewSht = ThisWorkbook.Sheets.Add
x(1, 1) = "Path"
x(1, 2) = "File Name"
x(1, 3) = "Last Accessed"
x(1, 4) = "Last Modified"
x(1, 5) = "Created"
x(1, 6) = "Type"
x(1, 7) = "Size"
x(1, 8) = "Owner"
x(1, 9) = "Author"
x(1, 10) = "Title"
x(1, 11) = "Comments"
i = 1
Set FSO = CreateObject("scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(MainFolderName)
'error handling to stop the obscure error that occurs at time when retrieving DateLastAccessed
On Error Resume Next
For Each Fil In oFolder.Files
Set objFolder = objShell.Namespace(oFolder.Path)
Set objFolderItem = objFolder.ParseName(Fil.Name)
i = i + 1
If i Mod 20 = 0 And TimeLimit <> 0 And Timer > (TimeLimit * 60 + StartTime) Then
GoTo FastExit
End If
If i Mod 50 = 0 Then
Application.StatusBar = "Processing File " & i
DoEvents
End If
x(i, 1) = oFolder.Path
x(i, 2) = Fil.Name
x(i, 3) = Fil.DateLastAccessed
x(i, 4) = Fil.DateLastModified
x(i, 5) = Fil.DateCreated
x(i, 6) = Fil.Type
x(i, 7) = Fil.Size
x(i, 8) = objFolder.GetDetailsOf(objFolderItem, 8)
x(i, 9) = objFolder.GetDetailsOf(objFolderItem, 9)
x(i, 10) = objFolder.GetDetailsOf(objFolderItem, 10)
x(i, 11) = objFolder.GetDetailsOf(objFolderItem, 14)
Next
'Get subdirectories
If TimeLimit = 0 Then
Call RecursiveFolder(oFolder, 0)
Else
If Timer < (TimeLimit * 60 + StartTime) Then Call RecursiveFolder(oFolder, TimeLimit * 60 + StartTime)
End If
FastExit:
Range("A:K") = x
If i < 65535 Then Range(Cells(i + 1, "A"), Cells(65536, "A")).EntireRow.Delete
Range("A:K").WrapText = False
Range("A:K").EntireColumn.AutoFit
Range("1:1").Font.Bold = True
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("a1").Activate
Set FSO = Nothing
Set objShell = Nothing
Set oFolder = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
Set Fil = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub
Sub RecursiveFolder(xFolder, TimeTest As Long)
Dim SubFld
For Each SubFld In xFolder.Subfolders
Set oFolder = FSO.GetFolder(SubFld)
Set objFolder = objShell.Namespace(SubFld.Path)
For Each Fil In SubFld.Files
Set objFolder = objShell.Namespace(oFolder.Path)
'Problem with objFolder at times
If Not objFolder Is Nothing Then
Set objFolderItem = objFolder.ParseName(Fil.Name)
i = i + 1
If i Mod 20 = 0 And TimeTest <> 0 And Timer > TimeTest Then
Exit Sub
End If
If i Mod 50 = 0 Then
Application.StatusBar = "Processing File " & i
DoEvents
End If
x(i, 1) = SubFld.Path
x(i, 2) = Fil.Name
x(i, 3) = Fil.DateLastAccessed
x(i, 4) = Fil.DateLastModified
x(i, 5) = Fil.DateCreated
x(i, 6) = Fil.Type
x(i, 7) = Fil.Size
x(i, 8) = objFolder.GetDetailsOf(objFolderItem, 8)
x(i, 9) = objFolder.GetDetailsOf(objFolderItem, 9)
x(i, 10) = objFolder.GetDetailsOf(objFolderItem, 10)
x(i, 11) = objFolder.GetDetailsOf(objFolderItem, 14)
Debug.Print x(i, 1), x(i, 2), x(i, 11)
Else
Debug.Print Fil.Path & " " & Fil.Name
End If
Next
Call RecursiveFolder(SubFld, TimeTest)
Next
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function -
Louro
őstag
válasz
Fferi50
#26604
üzenetére
Szia,
a cellák elé beírva, hogy melyik munkalapon találhatóak, úgy Type Mismatch. Ez se jó megoldás.
Szerk.: Úgy már sikerült, hogy a külön definiált range után még odapasszintottam a .address-t.
Péntek óta ismerkedek ezzel a kiegészítéssel is. Bár ha Range-ként definiáltam, akkor ezt feleslegesnek érzem, de biztos jó okkal hozták így létre.Szóval a jó megoldás:
Külön kellett deklarálni egy változót a range-nek, majd a függvényben úgy hivatkoztam rá ,hogy variable.address -
k_miso
tag
válasz
Fferi50
#26615
üzenetére
Szia!
Én is valami ilyesmiben gondolkodtam. Igazából a mentési nevet nem tudtam megoldani eddig. A forrás táblában van egy olyan oszlop, ami egyedi értéket tartalmaz, alkalmas lehetne fájl névnek is. Csak nem tudom, hogy hogyan lehet változót adni meg fájl névként.
Egyébként a sorok között nincs szünet. Ha mégis lenne, gondolom le lehetne szűrni egy adott mezőre, ahol mondjuk "1" érték van a használandó rekordon.miso
-
alfa20
senior tag
válasz
Fferi50
#26599
üzenetére
Köszi,
Közben meg oldottam másként.
Igazából amit tervezek:
1.) Megosztott munkafüzet, amit csak felhasználónév és jelszóval lehet megnyitni/szerkeszteni. - megoldva, a második munkafülbe tettem a felhasználónevet és jelszavakat, fehér betűszínnel írtam mindent, majd levédtem a munkalapot, semmit nem lehet vele kezdeni jelszó hiányában
2.) egyes userek csak bizonyos oszlopokba írhassanak - ezt úgy tervezem, elrejtek minden oszlopot, minden user-hez rendelek egy számot, ami majd belépéskor megadja kinek melyik oszlopot fedje fel. Azt mondjuk nem tudom, hogy lehet-e olyat, hogy a felfedést és elrejtést letiltani, hogy csak a makró fedjen fel oszlopokat, user nem tudjon.
3.) 'Admin' felhasználónak összes oszlop felfedése - na ez a legegyszerűbb Szóval ez lenne a tervem
legközelebb figyelek ra!
" & LastLine).Select
Kijelöli ugyan ugy az egesz tablat, ameddig be van kepletezve, nem csak addig amig erteket ad a keplet.
Akkor (KEREK.LE(A1;-1) lett volna a függvényben ![;]](http://cdn.rios.hu/dl/s/v1.gif)
)
Új hozzászólás Aktív témák
Hirdetés
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Assassin's Creed Shadows Collector's Edition PC
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Sea of Thieves Premium Edition és Egyéb Játékkulcsok.
- DELL PowerEdge R730xd 12LFF+2SFF rack szerver - 2xE5-2680v3,64GB RAM,4x1GbE,H730 RAID v ZFS
- AKCIÓ! Gigabyte H610M i5 12400F 32GB DDR4 512GB SSD RTX 3060Ti 8GB Rampage SHIVA Be Quiet! 730W
- Bontatlan SteelSeries QcK 3XL egérpad
- Telefon felvásárlás!! Apple Watch SE/Apple Watch SE 2 (2022)
- LG UltraGear Gaming Monitorok: FRISS SZÁLLÍTMÁNY -30%
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged