tak sem přilož přílohu ať víme co kam se má kopírovat.
Nejlepší je stav před a po.
Upravene makro.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oblast1 As Range, oblast2 As Range
Set oblast1 = Range("a5:a10005")
Set oblast2 = Range("k5:k10005")
If Not Intersect(Target, oblast1) Is Nothing Then 'aby to fungovalo jen pro vymezenou oblast
On Error GoTo err
If Target = "" Then
UserForm2.Show
End If
ElseIf Not Intersect(Target, oblast2) Is Nothing Then 'aby to fungovalo jen pro vymezenou oblast
On Error GoTo err
If Target = "" Then
UserForm3.Show
End If
End If
err:
End Sub
Pokud řádek na listu A = řádek na listu B tak porovnávej pouze datum v tom specialnim sloupci.
Pokud jsou řádky odlišné podle čeho se má řádek listu A s řádkem listu B kontrolovat ?
Tady je kousek makra jak kopírovat vyfiltrovaná data jinam.
Dim My_range As Range
Set My_range = Sheets(1).Range("A1:D100")
My_range.Parent.AutoFilter.Range.Copy
Sheets(2).Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
nebo
List1.Range("A1:D500").SpecialCells(xlCellTypeVisible).Copy Destination:=List2.Range("A1")
Pokud je to zalomeno Alt+Enter tak můžeš použít NAJIT( ZNAK(10)....
toto Value = SrcSh.[E50] = 0 nahraď tímto SrcSh.[E50] = 0
Další možnosti má Jirka Číhař dole pod O
http://dataspectrum.cz/pages/glossary/glossary.htm#t3
Super, díky moc
Ahoj,
nevíte někdo jak upravit pás karet podle svého?
Přidal jsem si tam jednu kartu, ale chtěl bych aby tam byla vidět jen ona a ne i ostatní (Domů, Vložení, Rozložení......)
Děkuji
Toto vlastním formátem nepůjde
jedině
- vlastní fcí
- pomocným sloupcem
- makrama
Zapoj fci KDYŽ
Zkus fci SUBTOTAL, umísti někam pod tabulku aby se ti výsledky neskrývaly když budeš filtrovat.
přes DATEDIF to lze také
=DATEDIF(DATUM(A1;1;1);DNES();"y")
kde v A1 je napsán pouze rok.
tak tak
Dim ChngRow As Integer
Dim ChngCell As Boolean
Dim ChngCellValueOld As Variant
Dim ChngCellValueNew As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim SrcRange As Range
Dim NewRow As Integer
'byla zmena a je vybran jiny radek od editovaneho?
If ChngCell = True And Not ActiveCell.Row = ChngRow And Not ChngCellValueOld = ChngCellValueNew Then
Set SrcRange = Range("A" & ChngRow & ":K" & ChngRow)
With Sheets("List2")
NewRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & NewRow & ":K" & NewRow).Value = SrcRange.Value
.Range("L" & NewRow).Value = Now
.Range("M" & NewRow).Value = Environ("username")
End With
End If
ChngCell = False
ChngCellValueOld = ActiveCell.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ChngRow = Target.Row
ChngCell = True
ChngCellValueNew = Target.Value
End Sub
Ale pokud se budou měnit i písmena tak vlatním formátem to nepůjde.
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.