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

Příspěvky uživatele

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šší?

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!

Ten kód není špatný, dělá přesně to co jsi popsal v zadání. Špatné jsou tvoje vyjadřovací schopnosti! Chtěl jsi smazat řádek, kde je ve sloupci AT text "-M-" (tedy pomlka em pomlka).

Chceš tedy tvůj "znak" hledat v textovém řetězci v buňce sloupce AT.
Ten tvůj znak je "-M-" nebo je má jednat jen o obyčejné "M"? Má se rozlišovat velikost písmena "M" či nikoliv?

Vzorec je maticový. Jeho zadání se ukončí trojkombinací
CTRL+SHIFT+ENTER

Postav se na buňku, kde máš vzorec. Stiskni F2 a poté ctrl+shift+enter a bude fungovat.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Formulář Faktura

Helios iNuvio

On-line nástroje