< návrat zpět

MS Excel


Téma: Vytváření složek dle označených buněk rss

Zaslal/a 4.5.2022 12:56

Ahoj,

Našel jsem zde a trošku modifkoval pro sebe následující makro. Zjednodušeně mi vytváří složky, které obsahují další dvě stabilní a neměné složky dle seznamu staveb. Ovšem rád bych toto ještě upravil tak, aby makro vytvořilo složky pouze z aktivních buněk. Např. při použití filtru,

Kód:
Sub VyvorSlozku_SUNSET_AMICOM()

Dim xdir As String

Dim lstrow As Long

Dim i As Long

lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

For i = 3 To lstrow

xdir = "C:\Users\Petr.Zemek\Desktop\Práce\VB\AMICOM\" & Range("B" & i).Value

On Error Resume Next

MkDir xdir

If Err.Number = 0 Then 'když existuje, jde dál

MkDir xdir & "\Podklady"
MkDir xdir & "\Výstavba"

End If

On Error GoTo 0

Next

End Sub

Díky za rady

Jméno
Kontrola
Text
  b i u s img code url hr   1 2 3 4 5 6 7 8 9 10

Strana:  1 2   další »
#052641
avatar
For i = 3 To lstrow

if not rows(i).hidden then
xdir = ...citovat
#052642
avatar

JoKe napsal/a:

For i = 3 To lstrow

if not rows(i).hidden then
xdir = ...


OK, takto tunkční.
Nicméně po testu neosvědčilo se takto.

Lze nějak tedy ošetřit , aby pracovalo pouze s myší označenými buňkami .... tedy např. 5 ( nově přidaných do databáze) ze všech 150 co ve sloupci jsou?

Díky za pomoc 1citovat
#052643
avatar
Dim cell As Range

For Each cell In Selectioncitovat
#052651
avatar
S tím aktuálním výběrem (Selection) zkusit průsečík dvou oblastí (Intersect), zde pokus najít viditelné buňky (resp. neskryté řádky filtrem či manuálně) ve sloupci B počínaje třetím řádkem ...
Dim rng(1 To 3) As Range, c As Range
Set rng(1) = Selection
Set rng(2) = rng(1).Parent.Range("B3:B" & rng(1).Parent.Cells(1).CurrentRegion.Rows.Count).SpecialCells(xlCellTypeVisible)
Set rng(3) = Application.Intersect(rng(2), rng(1))
For Each c In rng(3).Cells
Debug.Print c.Value
Next

Snad to bude fungovat s libovolným výběrem ...citovat
#052652
avatar
Pokus vypsat z tabulky (na aktivním listu s levým horním rohem v buňce A1 a záhlavím v prvním řádku) názvy složek ze sloupce B, kde není složka ještě založena ...

Upřesnění konktétního listu, stávající oblasti tabulky a cestu k hlavnímu adresáři upravit dle vlastního uvážení.

Dim folder_names
Const folder_path As String = "C:\Users\User\Desktop\AMICOM"
Dim current_range As Range
Dim ws As Worksheet: Set ws = ActiveSheet
With ws.Cells(1).CurrentRegion
If .Rows.Count > 0 And .Columns.Count > 0 Then
folder_names = Application.Transpose(.Columns("B").Offset(1).Resize(.Rows.Count - 1).Value)
End If
End With
Dim r As Long, new_items As New VBA.Collection
If Not IsEmpty(folder_names) Then
For r = LBound(folder_names) To UBound(folder_names)
'Debug.Print folder_names(r)
If Not Len(Dir(folder_path & Application.PathSeparator & folder_names(r), vbDirectory)) > 0 Then
new_items.Add folder_names(r)
End If
Next
End If
For r = 1 To new_items.Count
Debug.Print new_items(r)
'MkDir folder_path & Application.PathSeparator & cell_range.Value
Next
citovat
#052653
avatar
K plné spokojenosti ošetřeno následujícím kodem :

Sub VyvorSlozku_SUNSET_LIKEMA()

Dim xdir As String

Dim lstrow As Long

Dim i As Long
Dim cell As Range


lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

For Each cell In Selection

xdir = "E:\TEST\AMI\LIKEMA\" & cell.Value


On Error Resume Next

MkDir xdir

If Err.Number = 0 Then 'když existuje, jde dál

MkDir xdir & "\Podklady"
MkDir xdir & "\Výstavba"

End If

On Error GoTo 0

Next

End Sub

děkuji za pomoccitovat
#056236
avatar
Lepší způsob jak to udělat během par sec. je použít cmd (.bat soubor)

Pokud máte seznam jmen v excelu, doplňte pomocí vzorečku slovo MKdir před jmeno (název složky) a pokud obsahuje mezeru dejte název do uvozovek. Poté stačí jen zkopírovat do oznámkového bloku (NotePad), dát uložit jako a dopsat příponu .bat . Jakmile toto máte, supsťte .bat soubor ve složce kde chce aby se vytvořili a máte to.

Pokud chcete aby se cmd nezavřelo napište na konec puase jako je níže

Zde je ten 3 slovný kód 5 :

start
________
MKdir "Pixie Pin"

pause
________
konec

toto vytvoří složku s názvem Pixie Pin ve složce kde byl příkaz spuštěncitovat
#056237
elninoslov
No hej, ale reálny rozdiel/prínos bude aký? Aj tak si makrom musí urobiť zoznam z vybranej oblasti, a keď už makro beží, rovno sa názov môže poslať ako parameter do MkDir. Namiesto toho aby som si niekde uložil zoznam a potom ho nakopíroval do BAT (alebo makrom vytvoril BAT súbor). Aký bude časový rozdiel vykonávania operácie (spomínaných 5 foldrov)? 0,01 sek v prospech BAT?citovat
#056238
avatar
Pokud potřebuji opakovaně zakládat adresáře se zadanou strukturou, používám samozřejmě bat. Otevřu adresář a v něm spustím skript:

@echo off
chcp 1250 > nul:

if .%1.==.. (echo Není zadán adresář [nebo jiná zpráva] && goto konec)

mkdir .\%1 2> nul:
if errorlevel 1 (echo dir existuje && goto konec)

:: Do v závorce je seznam adresářů
for %%i in (Podklady AAA\Výstavba "X x x") do mkdir .\%1\%%i

echo hotovo

:konec
rem exit


Ve srovnání se skriptem v excelu je to o hodně rychlejší, a případná modifikace stromu adresářů je také velmi snadná.citovat
#056239
elninoslov
BAT bude rýchlejší, jasne to v poslednej vete píšem, ale tu sa jedná o mizivé počty, spomína 5 ks. Čo znamená, že najzdĺhavejšia časť, ktorá musí prebehnúť v oboch prípadoch, je vytvorenie zoznamu prechádzaním buniek (napr. Intersect zo Selection a/alebo SpecialCells). Pochybujem, že stačíte 2x mrknúť pri takom počte foldrov 5

Ale BAT bude vždy rýchlejší, to áno.citovat

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

kontrola buniek

Anonym • 27.5. 17:33

kontrola buniek

elninoslov • 27.5. 15:58

zoradit a zratat

elninoslov • 27.5. 15:16

Hromadné přepsání

Nomi • 27.5. 15:15

kontrola buniek

loksik.lubos • 27.5. 15:08

zoradit a zratat

lubo • 27.5. 13:23

kontrola buniek

elninoslov • 27.5. 12:56