Szia.
Pontosan ez a problémám, egy munkalap telel listákkal, rengeteg munkalap tele legördülő listákkal. Próbáltam a tiédhez hasonló egyszerű táblázattal kipróbálni ezt a makrót, de sajnos nekem valamiért nem fut le. Gondoltam ha egyszerű listával tudom használni, akkor majd át tudom írni a bonyolultabb feladatra. Tudnál nekem ebben segíteni?

Bejegyzés: Excel Validation List kiválasztott elemének automatikus frissítése

Kedves Office Guru!
Segítséget szeretnék kérni ezzel a témakörrel kapcsolatban. Adott egy 1900.01.01 előtti dátum és időszak napokban megadva. Hogyan tudom kivonni a dátumból a napok számát? Pl. 1875.07.16 - 188 nap =?
Segítségét előre is köszönöm.

Bejegyzés: Műveletek 1900 előtti dátumokkal Excelben

Uhh, ez tényleg hiánypótló...

Bejegyzés: Öt titkos vagy alig ismert Excel-funkció, amelyek színesebbé tehetik táblázatainkat

Köszönöm!

Most tudok csak újra foglalkozni a dologgal. Átnézem és jelentkezem. :)

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

általánosítva a feladatot:

Sub tesztdirlink()
Call DirLink("d:\mappa", Range("A1")) 'A1-től kezdve linkként a mappa fájlai
End Sub

Sub DirLink(honnan As String, hova As Range)

Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i As Integer

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(honnan)

i = 1
For Each File In Folder.Files
hova.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=File.Path, TextToDisplay:=File.Path
i = i + 1
Next File

End Sub

Ha meg kész szöveg fájlistával dolgozunk (pld. egy dir /b/s kimenete):
Sub ChangeToLink(mit As Range)
Dim c As Range

For Each c In mit.Cells
mit.Hyperlinks.Add Anchor:=c, Address:=c.Value, TextToDisplay:=c.Value
Next c
End Sub

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

@Bacsi Kornél:

Sub Listazo()
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i, ho, c As Integer

Set FSO = CreateObject("Scripting.FileSystemObject")

i = 1
'ho = Month(Now) '2020-ban melyik hónap van
ho = 12 '2019-re

For c = 1 To ho
Set Folder = FSO.GetFolder("d:\temp\2019\" & Format(c, "00"))
For Each File In Folder.Files
Cells(i + 1, 1) = File.Name
Cells(i + 1, 2) = File.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, 3), Address:=File.Path, TextToDisplay:=File.Path
i = i + 1
Next File
Next c
End Sub

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

@Bacsi Kornél: hát ha ez működik (bocs nem bogarásztam végig mit csinál), legegyszerűbb kivenni az útvonal generálást: pld.

sub hivo()
ho = Month(Now) 'melyik hónap van

For c = 1 To ho
call hivatkozás(Format(c, "00"))
next c
end sub

Sub hivatkozás(honap as string)
...
sPath = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019." & honap & "\"
...

(de ha megengedsz egy tanácsot, nem biztos, hogy ez a módszer a legjobb a programozás tanulásához, érdemesebb lenne az egyszerűbb felől (értve) a bonyolultabb felé menni))

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

Köszönöm a segítség megoldódott a problémám a listázással kapcsolatban.
A hivatkozással kapcsolatban kérhetek még segítséget?

Jelenleg ezzel a képlettel hivatkozom be pdf. fájlokat.

Sub hivatkozás()
Dim sPath As String, Value As String, cl As Range, usor As Integer, StartCell As Range
Dim WS As Worksheet

Set WS = Sheets("Kaizen összesítő") 'ide teszi a hivatkozást
sPath = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.01\"
Set StartCell = WS.Range("B3")
usor = WS.Range("B" & Rows.Count).End(xlUp).Row
For Each cl In WS.Range("B3:B" & usor)
cl.Hyperlinks.Delete
If Not IsEmpty(cl) Then
Value = Dir(sPath & cl.Value & ".pdf")
If Value <> "" Then
StartCell.Hyperlinks.Add Anchor:=StartCell, Address:= _
sPath & Value, TextToDisplay:=cl.Value
End If
End If
Set StartCell = StartCell.Offset(1, 0) ' a következő cella cime
Next
End Sub

Ebben az esetben mit kell módosítanom, hogy almappákból hivatkozzon?
Mindent a netről gyűjtögettem, és arról sajnos még keveset tudok, hogy mi mit jelent a képletben.

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

mivel Neked nem kell a rekurcziv listázás (tekintve, hogy tudod milyen mappák lesznek, legegyszerűbb így használnod:

Sub Listazo()
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i, ho, c As Integer

Set FSO = CreateObject("Scripting.FileSystemObject")

i = 1
ho = Month(Now) 'melyik hónap van

For c = 1 To ho
Set Folder = FSO.GetFolder("d:\temp\2020\" & Format(c, "00"))
For Each File In Folder.Files
Cells(i + 1, 1) = File.Name
Cells(i + 1, 2) = File.Path
i = i + 1
Next File
Next c
End Sub

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

de csináld így és így kilistázza az alkönyvtárakat is:
az msgbox azért kell, mert a shell még nem fut le, mire már nyitná a fájlt az excel :)

Sub dirtofile()
Dim i
i = Shell(pathname:="cmd.exe /k dir /b/s d:\Temp\2020 > d:\temp\list.txt", windowstyle:=vbHide)
MsgBox "listázva"
Workbooks.Open ("d:\temp\list.txt")
End Sub

azt/úgy sem vészes megírni, ahogy Te írtad, de ha azzal a listázóval csinálod a fájlnév listát, akkor kell a rekurziv rész is ami az alkönyvátrokba belemegy

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

@Bacsi Kornél: de működik a Tied, csak a 34.oszlopba írja a fájl nevét!

írd át: Cells(i + 1, 1) = File.Name -re

amúgy ezt kb. is megcsinálja:
Sub dirtofile()
Dim i
i = Shell(pathname:="cmd.exe /k dir /b d:\Temp\2020\01 > d:\temp\2020\01list.txt", windowstyle:=vbHide)
Workbooks.Open ("d:\temp\2020\01list.txt")
End Sub
ez kilistáz egy adott alkönyvtárat (pld. nálad 1 hónapot) és beolvassa excelbe

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

Lényegében ez a képlet az ami az adott mappát ki listázza.

Sub Listazo()
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("c:\")
i = 1
For Each File In Folder.files
Cells(i + 1, 1) = File.Name
Cells(i + 1, 2) = File.Path
i = i + 1
Next File
End Sub

Amit küldtél abban van egy javaslat:

' treelist.vbs
'
' Az aktualis mappat es az almappait kilistazza ltree.txt-be.
'
' Kiraly Tibor
' 2007-06-10

Dim oFSO, oFolder, listafile, filenev
Set oFSO= CreateObject( "Scripting.FileSystemObject")
filenev= "ltree.txt" ' lista file neve
Set oFolder= oFSO.GetFolder( ".") ' aktualis mappa beolvasasa

filenev= oFolder.Path& "\"& filenev ' lista file letrehozasa
Set listafile= oFSO.CreateTextFile( filenev)
Set listafile= Nothing

' mappak kilistazasa
Set listafile= oFSO.OpenTextFile( filenev, 2) ' file megnyitasa irasra
listafile.WriteLine( oFolder.Path) ' gyoker mappa kiirasa
almappa_kiiro( oFolder) ' almappak kiirasa
listafile.Close ' file lezarasa
'End of Script

Function almappa_kiiro( oMappa) ' almappakat kilistazo rekurziv fgv.
For Each oAlmappa in oMappa.SubFolders ' az oMappa-bol az osszes oAlmappa-an vegigmegy
listafile.WriteLine( oAlmappa.Path) ' kiirja az oAlmappa eleresi utjat
almappa_kiiro( oAlmappa) ' megnezi van-e almappaja - rekurzio
Next
End Function

És ebből ollóztam össze ezt.

Sub list()
Dim oFSO As Object
Dim oFolder As Object
Dim File As Object
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("D:\Users\kornel_bacsi\Desktop\Új kaizen összesítő\Kaizen ig. fotók 2019")
i = 2
For Each File In oFolder.Files
Cells(i + 1, 34) = File.Name
i = i + 1
Next File
End Sub

Futtatáskor nem dob fel hibát, de nem is történik semmi.

Sajnos itt megállt a tudományom.

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

Szia
A linkeket amiket küldtél, köszönöm. Átnézem őket, a Shell fügvénnyel nem biztos, hogy boldogulok.
Nagyon amatör vagyok a makró terén. Kevéske angol tudással fűszerezve :)
Lényegében amit szeretnék elérni:
Van egy exel táblázatom, amiben A3 cellából lefelé ismeretlen mennyiségű sorszámot írok, napi szinten. Általában évente 4-5 ezer közé és esik.
Ezek papír alapú munkaigénylők, amiket scannelek is.
A scannelt lapok egy külön mappában találhatók, amik minden évre külön mappát a mappán belül külön hónap mappákat tartalmaznak. A pdf fájlok ugyan azt a nevet kapják mint ami a sorszámuk.
Ezekből szeretném az exel táblázat AH3 cellájából lefelé haladva kilistázni az adott év mappájából és havi almappákból a pdf fájlok nevét.
Amit átnevezek az exelben.(a pdf. fájlnevet "leszedem" róluk) és egy keres függvénnyel nevük alapján ellenőrzöm, hogy scannelve van e a papír.
Ez lenne a listázási szakasz.
És a táblázat B3 celláiba a sorszámhoz tartozó pdf fájlt is be szeretném hivatkozni.
Ez is megy , de szintén csak az első hónapig.

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

@Bacsi Kornél: esetleg egy másik irányból egyszerűbb megközelíteni (nem tudom mire kell ez Neked) :
- a Shell függvénnyel meghívni egy küldő parancsot (dir), ami előállítja egy fájlba a kívánt listát egy fájlba írva
- aztán ezt a fájlt betölteni excelbe

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

@Bacsi Kornél: ezeket nézd meg (az első 2 igaz vbs, de átdolgozhatók VBA alá) tkiraaly.hu/muhely/vbscript/vbscript.html
www.radicspeter.hu/vegso/2018/12/23/program-mappa-meretek-vbs/
Excelre (nem ellenőriztem):
www.ozgrid.com/forum/index.php?thread/60566-list-folders-subfolders-from-directory/

@officeguru: kár, hogy nem frissül a blog

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

Szia

Kérdésem az lenne, hogy tudom elérni, hogy egy adott mappa almappáinak tartalmát listázza?
Nagyon amatőr vagyok a makro területén, és nagy segítség lenne számomra lényegében meg oldottam, csak sokkal bonyolultabban. Ez a kód jó lenne viszont csak egy adott mappát listáz.

A segítséget előre is köszönöm.

Bejegyzés: Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

@A Titán: feltételezve, hogy pld. A1-ben van a vizsgálandó szám, és a B1-ben akarjuk az eredményt látni, hogy prím-e: a B2 cellába kell a "=prim(A1)" képeltet írni

Bejegyzés: Exceles prímszám-vizsgálat igazi fanatikusoknak

Kedves cikk író!
Hogyan tudom elérni, hogy A1-be beírva egy számot jelenjen meg a TRUE vagy FALSE?
Az Alt+f11 és a modul1 feltöltése között nyilván be kell állítani valamit, de nekem ilyen nem látszik a leírásban.

Bejegyzés: Exceles prímszám-vizsgálat igazi fanatikusoknak

@anyadmajma: na, amekkora lúzer vagyok, megvan a megoldás.
Pedig mind a kb 25-30 oldalon, amin néztem oda volt írva, hogy VB-ben vesszőt kell rakni, nem pontosvesszőt elválasztónak, aztán majd amikor ő beírja a cellába a képletet, már pontosvesszőt fog rakni. meg magyarul fogja az angol képleteket is beírni (excel2016)

Bejegyzés: Hova tűnt a Share Workbook gombom?!

Üdv!

nem ehhez a témához tartozik, de ez az utolsó bejegyzés, és sehol nem találom a hibát, hogy mit írtam el.
VBA-ból kéne egy képletet beírni egy cellába (excel 2016).
CELLS(SOR, 6).FORMULA="IF(L1=N1+Q1+T1+W1+Z1+AC1+AF1+AI1+AL1+AO1;0;F1-E1)"
Beszúr egy sort, feltölti a kellő adatokkal, de ez a képlet nem látszik a cellában(G oszlop). ha kitörlöm az L oszlopból a feltöltött értéket, és beírom kézzel, akkor meg megjelenik a képlet a G oszlopba.
Mi lehet a hiba?
Előre is köszönöm a segítséget.

Bejegyzés: Hova tűnt a Share Workbook gombom?!