Příspěvky uživatele
< návrat zpět
Ahoj, zneužiju toto vlákno a zeptám se jak by se toto zadání dalo řešit pomocí VBA?
Pomocí pole dokážu rozdělit jednotlivé komodity, ale nedaří se mi oddělit množství (pro vedlejší sloupec).
Sub Rozdel()
Dim Pole() As String
Dim Pocet As Long
Dim Hodnoty As String
Hodnoty = Cells(1, 1).Value
Pole = Split(Hodnoty, ", ")
For Pocet = LBound(Pole) To UBound(Pole)
Cells(Pocet + 1, 5).Value = Trim(Pole(Pocet))
Next
End Sub
Lze vůbec pracovat (rozdělit) hodnoty načtené v poli nebo je jiná varianta (Collection)?
https://www.extendoffice.com/documents/excel/1252-excel-combine-cells-with-space-commas-semicolon.html
xlnc napsal/a:
Mimochodem pánové, od vás dvou bych čekal lepší makro než cyklus a Copy, když už.
Dobrá co takto:
Sub kopiruj_2()
Dim Posledni As Long
Dim Oblast As Range
Posledni = Cells(Rows.Count, 1).End(xlUp).Row
Set Oblast = Range("A1:A" & Posledni)
Oblast.Offset(, 1).Value = Oblast.Value
Set Oblast = Nothing
End Sub
Pokud se i tohle nelíbí, prosím o ten jediný správný kód. Rád se přiučím.
Nebo takto:
Sub kopiruj()
Dim Posledni As Long
Posledni = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & Posledni).Copy Range("B1")
End Sub
marficek119 napsal/a:
Proto jsem se ptal, zda má někdo zkušenost s takovým množstvím listů..nepsal jsem s daty, ale je logické, že si někdo nebude zakládat stovky prázdných listů jen proto, aby měl v sešitu stovky prázdných listů:-)
Dobře napíšu to jinak. Pavlus prohlásil, že "to" jde (jemu). V žádném případě neznamená, že "to" půjde i Vám. Dovolím si tvrdit, že jistě nemáte shodný HW. Před nedávnem jsem od známého dostal možnost vyzkoušet si na svém 6-7 let starém ntb office 2013. Půjde nainstalovat?
Ano půjde. Půjde s tím pracovat? Nikoliv. Stačilo do sešitu napsat několik jednoduchých vzorců (suma, když) a naplnit daty jeden sloupec po řádek 1000 a konečná - neustálé mrznutí excelu mě bavilo 2 dny. Následoval návrat k 2007. Přitom na jeho ntb excel 2013 pracoval naprosto bez sebemenších problémů.
Prostě toto si budete muset na svém stroji odzkoušet sám.
Ano bylo Vám odpovězeno, že "to" jde. Pavlus vložil 1000 listů, ale prázdných (pokud sem to správně pochopil). Myslím, že nikdo nemůže tušit, jak se takový soubor s 200 listy bude chovat poté co se naplní daty, případně se obohatí o nějaká makra či vzorce. Takže směle do toho pak tu můžete poreferovat, jak se to vlastně chová na konkrétním železe. 
To marficek119
Sorry, že se do toho pletu. Ale kdyby mi dodavatel poslal bezpečnostní nebo technické listy v excelu tak ho nakopu do (_!_). Jediný přijatelný formát je PDF. Ať ho budu tisknout kdekoliv pořád to bude vypadat stejně. Představ si, že přijde zákazník a bude k zakoupenému výrobku požadovat technický nebo bezpečnostní list. Dám se do tisku a místo toho aby z tiskárny vylezla jedna stránka vylezou 3 protože část textu přečuhuje. Něco podobného sem řešil s reklamačním protokolem v xls. Obchoďák přijel vytiskl 2 stránky. Já ten samý soubor otevřel ve svém PC vytiskl a vyjely 4. Dalších 20minut sem strávil úpravou souboru abych se dostal do požadovaného stavu a nevypadalo to že s tím počítačem pracuje totální jelito.
elninoslov napsal/a:
Návrh. Treba si v makre vyplniť údaje o maile (meno, heslo, server, toto je nastavené na gmail.com) a adresár pre zálohy. Políčko Zaúčtovaný neviem, čo s ním presne, tak sa loguje akože bunka B14, ale tam bude treba tie červené (asi). Neviem či to bude zlúčené, alebo sú tam 4 údaje (bunky). To upresnite. Vy sám F11 nemente. Iba v prípade prechodu na nový rok zmente na 001/2018. Ak by to mal používať aj niekto, kto nemá mať prístup k Vášmu mailovému kontu, treba to urobiť inak, cez posielanie v Outlooku.
To elninoslov
Ahoj, reaguji na Tvojí poslední větu "Ak by to mal používať aj niekto, kto nemá mať prístup k Vášmu mailovému kontu, treba to urobiť inak, cez posielanie v Outlooku."
Disponuješ takovým kódem, který je 100% funkční?
Kdysi sem s podobným "problémem" zápasil a nakonec zvítězil, ovšem odesílání fungovalo nejspíše podle aktuální konstalace hvězd, počasí nebo momentální nálady. Deset e-mailů odešlo bez problémů, několik se jich "zaseklo" ve složce "Pošta k odeslání" (excel otevíral Outlook na pozadí) a k fyzickému odeslání došlo až při opětovném spuštění Outlooku přes jeho zástupce. Poté opět několik e-mailů prolezlo bez problému a min jeden zůstal viset. Takto pořád dokola.
Dík.
Edit: Jednalo se o Office 2007
Takto?
Sub kopiruj_a_vymaz_2()
Dim i As Long
Dim maxRadek As Long
Dim Oblast As Range
Application.ScreenUpdating = False
maxRadek = List1.Cells(Rows.Count, 1).End(xlUp).Row
For i = maxRadek To 1 Step -1
Set Oblast = Union(List1.Cells(i, 1), List1.Cells(i, 4), List1.Cells(i, 6), List1.Cells(i, 8), List1.Cells(i, 10)) 'výběr buněk ve sloupcích A D F H J
If List1.Cells(i, 11).Value = "x" Then
List2.Range("A1").EntireRow.Insert
Oblast.Copy
List2.Range("A1:E1").PasteSpecial Paste:=xlPasteValues
List1.Rows(i).EntireRow.Delete
End If
Next i
Application.CutCopyMode = False
Set Oblast = Nothing
Application.ScreenUpdating = True
End Sub
S kopírováním pouze hodnot bez formátů není problém, ale k tomu prohození sloupců mě nenapadlo lepší řešení než pouze takto na "hulváta", možná se objeví znalejší s lepším postupem.
Sub kopiruj_a_vymaz_2()
Dim i As Long
Dim maxRadek As Long
Dim Oblast As Range
Application.ScreenUpdating = False
maxRadek = List1.Cells(Rows.Count, 1).End(xlUp).Row
For i = maxRadek To 1 Step -1
Set Oblast = Union(List1.Cells(i, 6), List1.Cells(i, 8), List1.Cells(i, 10)) 'výběr buněk ve sloupcích F H J
If List1.Cells(i, 11).Value = "x" Then
List2.Range("A1").EntireRow.Insert
List1.Cells(i, 1).Copy
List2.Cells(1, 2).PasteSpecial Paste:=xlPasteValues
List1.Cells(i, 4).Copy
List2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Oblast.Copy
List2.Range("C1:E1").PasteSpecial Paste:=xlPasteValues
List1.Rows(i).EntireRow.Delete
End If
Next i
Application.CutCopyMode = False
Set Oblast = Nothing
Application.ScreenUpdating = True
End Sub
Např:
Sub kopiruj_a_vymaz_2()
Dim i As Long
Dim maxRadek As Long
Dim Oblast As Range
Application.ScreenUpdating = False
maxRadek = List1.Cells(Rows.Count, 1).End(xlUp).Row
For i = maxRadek To 1 Step -1
Set Oblast = Union(List1.Cells(i, 1), List1.Cells(i, 4), List1.Cells(i, 6), List1.Cells(i, 8), List1.Cells(i, 10)) 'výběr buněk ve sloupcích A D F H J
If List1.Cells(i, 11).Value = "x" Then
List2.Range("A1").EntireRow.Insert
Oblast.Copy List2.Range("A1:E1")
List1.Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Ahoj vyzkoušej tento kód (na kopii sešitu).
Sub kopiruj_a_vymaz()
Dim i As Long
Dim maxRadek As Long
Application.ScreenUpdating = False
maxRadek = List1.Cells(Rows.Count, 1).End(xlUp).Row
For i = maxRadek To 1 Step -1
If List1.Cells(i, 11).Value = "x" Then
List2.Range("A1").EntireRow.Insert
List1.Range("C" & i & ":" & "F" & i).Copy List2.Range("A1:D1")
List1.Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Nebo:
=SUMA(NEPŘÍMÝ.ODKAZ(ODKAZ(1;SLOUPEC()-1)):NEPŘÍMÝ.ODKAZ(ODKAZ(ŘÁDEK();SLOUPEC()-1)))
Jak je vidět řešení je povícero.
Úplně stejně jako ta druhá část, akorát řádek vložíš "natvrdo" 1
Co nejde? Už si vyzkoušel ten vzorec?
1.12.2017 = 43070
1.1.2018 = 43101
co je vyšší?
Uživatelské menu
\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