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

Příspěvky uživatele

Přidal jsem jednu proměnou do každého listu a tu jsem přidal do makra "řádky".

Vlož do modulu listu, kde chceš mít tu zamknutou buňku.
Platí pro E10 a heslo "heslo", změň dle sebe.
Dim pwd As String

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("E10").Address Then
If Not pwd = "heslo" Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
MsgBox "neplatne heslo"
End With
End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address = Range("E10").Address Then

pwd = InputBox("Zadej heslo", "Password", "password")

If Not pwd = "heslo" Then
MsgBox "Neplatne heslo"
End If
End If
End Sub

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _
SubAddress:="'nazev listu'!" & Sheets("nazev listu").Range("I" & Rows.Count).End(xlUp).Row + 1, _
ScreenTip:="komentar", _
TextToDisplay:="zobrazovany text"

Do A1 dej =B7

Udělej si list "mustr" a ten si vždy zkopíruj a přejmenuj
(pravým tl. .. přesunout kopírovat ... vytvořit kopii)
nebo si vytvoř makro, kterým pak naformátuješ nový list tak jak potřebuješ,
ale ta první možnost je lepší na pozdější úpravy.

Tak asi něco dělám špatně. Mě to nezlobí.

Posílám příklad.

Ještě bych to rád upravil tak, aby se nekopírovalo v případě, když se celý řádek označí a hodnoty v něm se smažou (první otázka se týkala postupného vymyzávání).
To je nějaká mýlka, přečti si svuj požadavek, upravil jsem tvoje makro.

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
Dim CllSrcRange As Range

If ChngCell = True And Not ActiveCell.Row = ChngRow And Not ChngCellValueOld = ChngCellValueNew Then

Set SrcRange = Range("D" & ChngRow & ":S" & ChngRow)

Application.EnableEvents = False
Range("S" & ChngRow).Value = Now
Application.EnableEvents = True

With Sheets("History")
.Range("a5").EntireRow.Insert
.Range("5:5").ClearFormats
.Range("A5:N5").Value = SrcRange.Value
.Range("O5").Value = Now
End With
Set CllSrcRange = Nothing
End If
ChngCell = False
ChngCellValueOld = ActiveCell.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cll As Range

For Each Cll In Target.Cells
If IsEmpty(Cll) Then
Else
ChngRow = Target.Row
ChngCell = True
ChngCellValueNew = Target.Resize(1, 1).Value
Exit For
End If
Next
End Sub

Tady koukni do přílohy, mě to jde.

Tady je varianta maticoveho vzorce co upravuješ, vlož do tvé buňky F3586.
=KDYŽ(ŘÁDEK()-3585>COUNTIF($F$3:$F$3568;1);"";INDEX($B$3:$B$3568;SMALL(KDYŽ($F$3:$F$3568=1;ŘÁDEK($F$3:$F$3568)-2;1000000);ŘÁDEK()-3585)))

Řešení od eLCHy do makra.

Číslo se vypíše do sl.A aktivního řádku.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 2 Then
Cells(Target.Row, "A").FormulaArray = "=MAX(R2C4:R65536C4*(R2C2:R65536C2=R" & Target.Row & "C2))+1"
Cells(Target.Row, "A") = Cells(Target.Row, "A")
End If
End Sub

Tady je makro, které si musíš trochu doupravit, páč nevím jaké makro máš.

Sub KopirujJenKdyzNecoJe()
Dim SrcRange As Range, CllSrcRange As Range
Dim ChngRow As Integer

Set SrcRange = Range("A" & ChngRow & ":K" & ChngRow)

'jsou vsechny bunky prazdne? pokud ano nedelej nic
For Each CllSrcRange In SrcRange.Cells
If IsEmpty(CllSrcRange) Then
'nedelej nic
Else
'sem napis to kopirovani
Exit For
End If
Next CllSrcRange
Set CllSrcRange = Nothing
End Sub

Tak toho jsem si nevšim, on to tam lubo dává od 1.řádku (viz. 1.příspěvek)
Takže aby to platilo až od druhého řádku tak upravit vzorec na
=KDYŽ(ŘÁDEK()-1>COUNTIF($D$1:$D$29;1);"";INDEX($A$1:$A$100;SMALL(KDYŽ($D$1:$D$100=1;ŘÁDEK($D$1:$D$100);1000000);ŘÁDEK()-1)))

@Merlin99
Použij vzorec výše, uprav akorát sloupce a celkový počet řádků (od prvního řádku nechej)

@All
Ano pro další sloupce lze použít např. SVYHLEDAT

Ale jak pise Lubo, chce to ty vzorce pochopit.

Dá se řešit bez VBA pomocí ovládacího prvku formuláře "číselník".

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse