Příspěvky uživatele

elninoslov ďakujem funguje mi to, len som si to trochu upravil.
Vrátil som tam späť GetDetailsOf pretože ten spôsob čo ste spravili vy mi tam dáva aj nejaké súbory čo na disku nemám. Možno nejaké skryté alebo niečo a nevedel som ako sa toho zbaviť.
Chcem tomu trošku aj porozumieť aby som sa dobudúcna nepýtal, ak by si bol ochotný mi to vysvetliť mal by som pár otázok.
Prečo je Set WS = ThisWorkbook.Worksheets("zdroj Axagon n.o 2") lepšie ako to čo som mal ja? je tam nejaký rozdiel?

Ked si to hodite do excelu tak to je prehladnejsie. Takto tu to naozaj pôsobý rozsiahlo.

Zdravím, niekto mi tu kedysi napísal makro na vytiahnutie súborov z disku a zapísanie ich ako zoznam do excelu. Potreboval by som ešte aby sa hodnota názov disku tak isto zapísala do každého riadka tak ako ostatné údaje teraz sa zapíše iba do jednej bunky. prikladám kód.
Dim objFSO As Object, objShell As Object
Dim Info()
Dim CountFiles As Long
Dim Hárok As String

Sub PrintFolders2() 'testovaci
Dim folder As String, bPrint As Boolean
Hárok = "zdroj Axagon n.o 2" 'názov hárku na ktorom sa má spustit makro

folder = Sheets(Hárok).Range("J2").Value 'pismeno disku
'kontrola správnosti cesty ak je zle zadana cesta k disku
If Len(folder) = 0 Then
GoTo FOLDER_ERROR
ElseIf Len(folder) = 1 Then
folder = folder & ":"
End If
folder = Left$(folder, Len(folder) - IIf(Right$(folder, 1) = "\", 1, 0))
If Len(Dir(folder, vbDirectory)) = 0 Then GoTo FOLDER_ERROR

'vymazanie starých dát
Sheets(Hárok).Range("C2:I2").Resize(Sheets(Hárok).Cells(Rows.Count, "C").End(xlUp).Row).ClearContents
Sheets(Hárok).Range("A3:B3").Resize(Sheets(Hárok).Cells(Rows.Count, "C").End(xlUp).Row).ClearContents

'ziksanie nazvu disku
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Sheets(Hárok).Range("I2") = objFSO.GetDrive(objFSO.GetDriveName(folder)).VolumeName
CountFiles = 0
Erase Info()

On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler

'rekurzívne volanie prechádzania adresárov
GetFiles objFSO.GetFolder(folder)
bPrint = CountFiles > 0
GoTo END_PROC

FOLDER_ERROR:
MsgBox "Zle zadane pismeno disku!", vbExclamation
GoTo END_PROC

handleCancel:
If Err = 18 Then
If CountFiles > 0 Then bPrint = MsgBox("You cancelled." & vbNewLine & vbNewLine & "You want to write a partial result ?", vbQuestion + vbYesNo) = vbYes
End If

END_PROC:
' stlpec
If bPrint Then Sheets(Hárok).Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(CountFiles, 6).Value = Application.Transpose(Info): Sheets(Hárok).Activate

Sheets(Hárok).Range("A2:B2").AutoFill Sheets(Hárok).Range("A2:B" & Sheets(Hárok).Range("C" & Rows.Count).End(xlUp).Row) 'vzorce potiahne potial pokial su udaje
'Call Module3.zdroj_do_tabulka 'spusti makro na kopirovanie do tabulky

Set objFSO = Nothing: Set objShell = Nothing: Set objFSO = Nothing: Erase Info()
End Sub

Sub GetFiles(ByRef objFolder As Object)
Dim obj As Object, vFile, Count As Long, radek As Long
If Len(Dir(objFolder.Path, vbDirectory)) = 0 Then Exit Sub
Count = objFolder.Files.Count
If Count > 0 Then 'ak sú nejaké súbory tak zväčši pole výsledkov
radek = CountFiles
CountFiles = CountFiles + Count
ReDim Preserve Info(3 To 8, 1 To CountFiles) 'od akeho po aky stlpec

'prejdi súbory v adresári
With objShell.Namespace(objFolder.Path)
For Each obj In objFolder.Files
radek = radek + 1
Info(8, radek) = obj.Path 'cesta k suboru
Set vFile = .ParseName(obj.Name)
Info(6, radek) = .GetDetailsOf(vFile, 0) 'nazov s priponou
Info(7, radek) = .GetDetailsOf(vFile, 190) 'priecinok v ktorom je subor
Info(5, radek) = .GetDetailsOf(vFile, 164) 'pripona
Info(3, radek) = .GetDetailsOf(vFile, 1) 'velkost
Info(4, radek) = .GetDetailsOf(vFile, 27) 'dĺžka filmu
Next obj
End With
End If

'prejdi podadresáre a volaj znovu rekurzívnu metódu
For Each obj In objFolder.SubFolders
GetFiles obj
Next obj

Set obj = Nothing: Set vFile = Nothing
End Sub

Potreboval by som aby tento kus kodu, vytahoval udaje do kazdeho riadka v stlpci I pokial tam sú údaje. 'ziksanie nazvu disku
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Sheets(Hárok).Range("I2") = objFSO.GetDrive(objFSO.GetDriveName(folder)).VolumeName
CountFiles = 0
Erase Info()
Dúfam že ma chápete. Ked nie pýtajte sa :D Dakujem vopred za pomoc.

Ano počet filmov v tom stlpci, ale to nieje az tak podstatne. Prikladam teda súbor. Chcem si vytvorit tabulku kde budem mať zoznam filmov. Už som to tu riešil ako vyčitat subory z disku to mi funguje. Teraz skúšam ako by to vyzeralo najlepšie po nejakej úprave. Na hárku disk je zoznam ktorý makro vyčíta z disku. Ten skúšam dalej spracovať do nejakej prívetivej podoby. Na hárku1 skúšam tabulku ako bude pohodlné filtrovať v nej a + som včera našiel taký dynamický filter tak som tam skúšal ten a vyzerá dobre.

Na hárku3 som skúšal to čo som sa pýtal hore ako to rozbiť do kategórii, s vlookupom to funguje, ale ked to dám zoradiť od a-z tak mi to dá prvé hodnoty prázdne a neviem ako to spraviť aby to nebralo tie prázdne hodnoty. Viem že tam je vzorec a zato to robí,len neviem riešenie.

Tak som to vyriešil z časti funkciou vlookup.

A aby to vyzeralo takto.

Zdravím neviem či som to vôbec dobre pomenoval. Hladám spôsob či už cez kontingenčnú, makro alebo power query ako spraviť toto. V jednom stlpci v zozname sú údaje ktoré sa opakujú a potrebujem ich rozdelit do hlaviciek tabulky a priradit knim odpovedajúce dáta.

Už bol večer a asi som už driemal. Dnes som sa nato pozrel kód si odkrokoval a našiel chybu. Samozrejme bola u mňa, takže ďakujem a funguje.

marjankaj celkom nechápem kde sa tam maju tie stlpce menit.

elninoslov celkom chápem princíp, ale nefunguje mi to spraví to len stĺpec D a K ostatne to vynechá.

Pomáhal som si záznamom makra a potom to upravoval tak sú tam ešte nedostatky.

Ahojte, mam macro a vnom dlhu cast kodu v ktorom je tento riadok Range("D4:D200").Select potreboval by som tu cast zopakovat tak aby bolo zakazdym ine pismeno cize stlpec. Pismena musia byt v tomto poradi D,G,H,I,J,K.
Vedel by som tu cast napisat 6x pod seba a fungovalo by to, ale chcel by som vidiet spôsob ako sa to má robit. Dakujem ak si niekto nájde čas.

"Nie, zmena toho riadku iba spôsobí, že sa dáta neprepíšu od bunky A2, ale pridajú sa až za poslednou vyplnenou v stĺpci A. Teda vyhovenie požiadavke neprepisovania, ale pridávania."

Chapem ale pridaju sa tam aj dáta ktoré už v zozname sú a to mi tiež nevyhovuje.
Tiež to nechcem komplikovať viac ako to je. Môžu byť 2 skripty s 2 roznymy cestamy pre 2 rozdielne disky a každý by bol na inom hárku. Viem že keby to chcem blbuvzorné tak mi to nikto zadarmo nenapíše lebo by ten kód bol na 2000 riadkov.
Skúsim napísať ako by som si predstavoval body čo ste rozpísali, potom mi prosím napíšte či by to bolo jednoducho realizovatelné alebo nejak strašne zložité.
"""Ak film fyzicky zmažem, spustím makro, ako makro zistí, či som film zmazal alebo či tam nikdy nebol?"""
Tak keď nieje na disku tak ho odstráni aj z databázy.
"""Spustím makro s diskom ABC, bude tam film Avatar.mkv. Potom spustím makro na disku DEF, kde bude tiež Avatar.mkv. Čo teraz? Je to iný film s rovnakým názvom? Rovnaký v inej kvalite? Ten istý iba presunutý na iný disk? Odkiaľ toto makro zistí? Dajme tomu, že keď je z iného disku, tak sa pridá. Teda budú tam dva Avatar.mkv. Potom ho presuniem na tretí disk, alebo do iného adresára. Spustím makro, a čo teraz? Pridá tretí? Zmaže prvý, druhý, ... ?"""
No bude tam predsa aj ten názov disku a každý disk sa bude volať ináč tak podľa toho to bude vedieť.Do tej databázy by som to chcel tak že čo je na disku to je v databáze.

Popravde s databazou som ešte nepracoval, ale ako píšete priradovať ID k dátam by bolo asi najlepšie.
Ako píšete do toho zoznamu/databázy by sa mali dostať všetky filmy z disku a nemali by sa tam opakovať. Ak pridám na disk dalši film alebo nejaky vymažem tak aby sa do databazy pridal len ten alebo aby z nej len ten zmizol. To s tým názvom disku som chcel samozrejme na všetky riadky, len som sa k tomu ešte nedostal.

Skúsil som zmenit ten kod ako ste mi radili
END_PROC:

If bPrint Then Sheets("Hárok2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(CountFiles, 6).Value = Application.Transpose(Info): Sheets("Hárok2").Activate
ale zoznam sa duplicitoval či mám nechať aj ten prikaz na mazanie zoznamu čo je na začiatku?

No premyslím si to ešte a skúsim si to nejak utriediť a rozkresliť na papier čo by to malo robiť.

Vdaka oprava funguje. Bol by som ti vdačný ak by si mi s tým pomáhal aj dalej. Zatial teda dakujem a ozvi sa ked budeš mať čas.

A teraz som vlastne zistil že tam nemôže byť to mazanie toho zoznamu čo je hned na začiatku. Tie dáta chcem použit ako databázu a dalej s nimi pracovať a priradovat k nim veci.
Teraz som zistil že ak to zmažem a znova načítam tak mi tie veci čo som knim priradil náhodne priradí k iným filmom. Dúfam že ma chápete.

Edit: tak som zistil že ten tvoj bude dobrý lebo stačilo odstrániť to mazanie a ked ho opakovane spúštam tak tam nerobí duplicity ako ten čo som mal predtým. Takže to je ok.

Vdaka s progress barom sa netráp to nepotrebujem. Len mi to nefunguje ak napíšem H:\ ,musím začat s priečinkom napr. H:\Filmy budem si nad tým lámať hlavu kým mi to nespravíš ty :D alebo sa mi to zázrakom podarí, pretože si ten script celý prerobil a strácam sa tam :D

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje