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.
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šší?
Merlin99 napsal/a:
ano ale jen rikam ze když nastane 2. mesic tak vynecha všechny 1. mesice a to i u roku 2018 a to by nemel ten je vyssi... Orisek
marjankaj napsal/a:
No pozrel som súbor
=SUMIFS($G8:$AD8;$G$7:$AD$7;CONCATENATE(">=";DATE(YEAR(TODAY());MONTH(TODAY());1)))
=SUMIFS($G8:$AD8;$G$7:$AD$7;CONCATENATE(">=";DATum(rok(dnes());měsíc(dnes());1)))
Zřejmě sem nepochopil zadání pokud můj vzorec je chybný. V tom případě je Váš v pořádku a vrací relevantní výsledek.
Dnes je 6.1.2017, leden v roce 2017 je zadán jako 1.1.2017 tudíž se podle podnínky >= nezahrne do součtu.
?
=SUMIFS($G8:$AD8;$G$7:$AD$7;">="&MĚSÍC(DNES()))
Zkus to znovu, zrovna sem editoval kód. Nějak se tu peru s fórem kua.
V tom případě vyzkoušej(na kopii svých dat) toto:
Sub Vymaz_radky_podle_podminky()
Dim i As Long
For i = Range("AT" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 46).Text Like "*-M-*" Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
Edit: Kod upraven, vypadly mi tam ty pomlky!
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.