• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

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.

Zaslat odpověď >

---

Pavlus(11.6.2019 17:40)#043507

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

Lugr(11.6.2019 17:44)#043508

Asi by to šlo vyřešit textem do sloupců

Karta Data -> Text do sloupců

Přihoďte přílohu a mrknem na tocitovat

kalisci(11.6.2019 21:09)#043510

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é?

Příloha: 43510_seznam-pisni-wall.xlsx (39kB, staženo 36x)

citovat

a.mlady(12.6.2019 6:53)#043511

Zdravím,
prozatím vyřešeno bez pomlčky.

Příloha: 43511_seznam-pisni-wall.xlsx (39kB, staženo 41x)

citovat

elninoslov(15.6.2019 13:51)#043532

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

Příloha: 43532_43510_seznam-pisni-wall.zip (61kB, staženo 24x)

citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse