Ad 1 = Vyřešit lze například přes funkce ČÁST, NAJÍT, DÉLKA. Případně si lze pohrát s funkcemi ZLEVA/ZPRAVA, NAJÍT.
P.citovat
P.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Rozdělení textu na dvě části - do dvou buněk ...
MS Excel
Téma: Rozdělení textu na dvě části - do dvou buněk ... 
Zaslal/a kalisci 11.6.2019 14:23
Zdravím,
chtěl bych požádat o pomoc jak rozdělit v excelu text, který mám v jedné buňce do dvou buněk. Mám poměrně velký naskenovaný archív notového materiálu, a potřeboval bych ho nějak roztřídit (ale nějak automaticky, protože jinak je to práce na desítky hodin..)
V názvu je vždy interpret, mezera, pomlčka, mezera a pak název skladby:
Lucie Bílá - Most přes minulost
1) Potřeboval bych v excelu tuto buňku (A1) rozdělit na dvě:
to co je před pomlčkou do jedné buňky (třeba B1) a to co je za pomlčkou do druhé buňky (C1). Někdy je v názvu ještě další pomlčka, ale ta by se měla ignorovat. Rozdělovat by se mělo vždy první pomlčkou.
2) Dále zda by šlo automaticky vytvořit složky dle buněk ve sloupci B. Pokud by již složka existovala, další by se nevytvářela.
3) Následně by ještě bylo nutné automaticky přesunout samotné soubory not např: Lucie Bílá - Most přes minulost.pdf (mohou být i jiné koncovky), do jednotlivých složek, které se vytvořily, tzn v tomto případě do složky Lucie Bílá.
Nevím, zda je to reálné, ale snad nějak ano. Třídit a vše přepisovat ručně je na poměrně dost dlouhou dobu.
Předem děkuji za případnou pomoc.
Asi by to šlo vyřešit textem do sloupců
Karta Data -> Text do sloupců
Přihoďte přílohu a mrknem na tocitovat
Karta Data -> Text do sloupců
Přihoďte přílohu a mrknem na tocitovat
Přikládám soubor se seznamem souborů - malá část notového archívu.
Rozdělení názvů se mi povedlo udělat částečně (neumím vyřešit to, pokud název neobsahuje pomlčku....)
Teď bych ale potřeboval automaticky vytvořit složky dle sloupce D. Potom do nich přesunout soubory ze složky - viz seznam.
Je to nějak možné?
Rozdělení názvů se mi povedlo udělat částečně (neumím vyřešit to, pokud název neobsahuje pomlčku....)
Teď bych ale potřeboval automaticky vytvořit složky dle sloupce D. Potom do nich přesunout soubory ze složky - viz seznam.
Je to nějak možné?
Příloha: 
43510_seznam-pisni-wall.xlsx (39kB, staženo 37x)
citovat43510_seznam-pisni-wall.xlsx (39kB, staženo 37x)Zdravím,
prozatím vyřešeno bez pomlčky.
prozatím vyřešeno bez pomlčky.
Příloha: 43511_seznam-pisni-wall.xlsx (39kB, staženo 42x)
citovat43511_seznam-pisni-wall.xlsx (39kB, staženo 42x)Vyskúšajte toto. Ale skúšajte to výhradne na kópii časti súborov. Ak by to nerobilo, to čo chcete, aby ste nemal potom guláš.
Sub Presun()
Dim Data(), R As Long, i As Long, OldSoubor As String, Interpret As String, Pisen As String, Casti() As String, Cesta As String, Vysledek() As String, FSO As Object
Const ROZDEL$ = " - "
Const BEZ_INTERPRETA$ = "Bez interpreta"
Const NEEXISTUJE$ = "Neexistuje"
Const NEPRESUNUTELNY$ = "Nepřesunutelný"
Const OK$ = "OK"
With ThisWorkbook.ActiveSheet
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 0 Then MsgBox "Žádné řádky dat.", vbExclamation: Exit Sub
Data = .Cells(2, 1).Resize(R, 3).Value
ReDim Vysledek(1 To R, 1 To 3)
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To R
Casti = Split(Data(i, 2), ROZDEL)
If UBound(Casti) > 0 Then
Interpret = Casti(0)
Pisen = Casti(1)
Vysledek(i, 1) = Interpret
Else
Interpret = BEZ_INTERPRETA
Pisen = Casti(0)
End If
Vysledek(i, 2) = Pisen
Cesta = Data(i, 1) & Interpret & "\"
OldSoubor = Data(i, 1) & Data(i, 2) & "." & Data(i, 3)
If Len(Dir(OldSoubor, vbNormal)) = 0 Then
Vysledek(i, 3) = NEEXISTUJE
Else
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
On Error Resume Next
FSO.MoveFile OldSoubor, Cesta & Data(i, 2) & "." & Data(i, 3)
Vysledek(i, 3) = IIf(Err.Number <> 0, NEPRESUNUTELNY, OK)
On Error GoTo 0
End If
Next i
.Cells(2, 4).Resize(R, 3).Value = Vysledek
End With
End Sub
Sub Presun()
Dim Data(), R As Long, i As Long, OldSoubor As String, Interpret As String, Pisen As String, Casti() As String, Cesta As String, Vysledek() As String, FSO As Object
Const ROZDEL$ = " - "
Const BEZ_INTERPRETA$ = "Bez interpreta"
Const NEEXISTUJE$ = "Neexistuje"
Const NEPRESUNUTELNY$ = "Nepřesunutelný"
Const OK$ = "OK"
With ThisWorkbook.ActiveSheet
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 0 Then MsgBox "Žádné řádky dat.", vbExclamation: Exit Sub
Data = .Cells(2, 1).Resize(R, 3).Value
ReDim Vysledek(1 To R, 1 To 3)
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To R
Casti = Split(Data(i, 2), ROZDEL)
If UBound(Casti) > 0 Then
Interpret = Casti(0)
Pisen = Casti(1)
Vysledek(i, 1) = Interpret
Else
Interpret = BEZ_INTERPRETA
Pisen = Casti(0)
End If
Vysledek(i, 2) = Pisen
Cesta = Data(i, 1) & Interpret & "\"
OldSoubor = Data(i, 1) & Data(i, 2) & "." & Data(i, 3)
If Len(Dir(OldSoubor, vbNormal)) = 0 Then
Vysledek(i, 3) = NEEXISTUJE
Else
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
On Error Resume Next
FSO.MoveFile OldSoubor, Cesta & Data(i, 2) & "." & Data(i, 3)
Vysledek(i, 3) = IIf(Err.Number <> 0, NEPRESUNUTELNY, OK)
On Error GoTo 0
End If
Next i
.Cells(2, 4).Resize(R, 3).Value = Vysledek
End With
End Sub
Příloha: 
43532_43510_seznam-pisni-wall.zip (61kB, staženo 25x)
citovat43532_43510_seznam-pisni-wall.zip (61kB, staženo 25x)Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články