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

Příspěvky uživatele

Tady je oprava.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRowName As Byte
Dim cell As Range
Dim FindName As Range

LastRowName = Cells(Rows.Count, "B").End(xlUp).Row

For Each cell In Range("P6:AA" & LastRowName)

If Not IsEmpty(cell) Then

Set FindName = Range("B6:B" & LastRowName).Find(What:=cell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

On Error Resume Next
cell.Interior.Color = FindName.Interior.Color
On Error GoTo 0

End If
Next
End Sub


Jinak bych na to zadávání jmen použil seznam (data - ověření dat - seznam)

uprav dle své tabulky

=CHYBHODN(SVYHLEDAT(List2!A3;List1!A3:C7;2;0);"error")

pro jeden sloupec, pro druhý musíš změnit akorát číslo sloupce na 3 ve fci svyhledat

ad1 )
Použij makro (třeba),
vlož do modulu listu.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRowName As Byte
Dim cell As Range
Dim FindName As Range

LastRowName = Cells(Rows.Count, "B").End(xlUp).Row

For Each cell In Range("P6:AA" & LastRowName)

If IsEmpty(cell) Then
GoTo dalsi
End If

Set FindName = Range("B6:B" & LastRowName).Find(What:=cell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

cell.Interior.Color = FindName.Interior.Color

dalsi:
Next
End Sub
ad 2)
použij fci Countif

Nahraď řádek
Worksheets("Databáze nabídek").Cells(radek, 3) = Worksheets("Pom list").Range("C6:CPR6")
tímto
Worksheets("Databáze nabídek").Range("C" & radek & ":CPR" & radek).Value = Worksheets("Pom list").Range("C6:CPR6").Value

Musíš se takto odkazovat na stejnou oblast.

Udělal bych pomocí kontingenční tabulky.
Pokud jsou data pokaždé někde jinde tak bych je vždy naskládal do jiného listu tak abych je mohl používat v KT.

Uprav vzorec takto
=KDYŽ(JE.CHYBHODN(POZVYHLEDAT(A1;$C$1:$C$5;0));"";SVYHLEDAT(A1;$C$1:$D$5;2;0))
V buňce se zobrazí hodnota z D na stejném řádku.

Vzorcem takto

=VPRAVO(A1;DÉLKA(A1)-HLEDAT("_";A1;1))

Sub UlozList()
'
' ulozi kopii listu do noveho sesitu
Sheets("List1").Copy

' ulozi soubor jako
ActiveWorkbook.SaveAs "c:\Záloha\" & "Záloha_" & (Format(Now, "d.m.yyyy")) & ".xlsm"
ActiveWorkbook.Close
End Sub

Stačí mít jedno makro Sub CountPrint()
ActiveSheet.Cells(1, 1) = ActiveSheet.Cells(1, 1) + 1
End Sub
A jen ho pak přiřazovat tlačítkům.

A to tlačítko pro tisk všech listů rozkopírovat na jednotlivé listy, ale záleží jak je napsané a kde makro umístěné.

Ten název vlákna je fakt výstižný

Ale toto by ti mohlo stačit
http://www.contextures.com/xlDataEntry02.html

Tak pak bys musel mít nalistu jednu pomocnou buňku, ve které by bylo číslo poslední verze.
zde List1 A1

"e:\test\" & Format(Sheets("List1").Range("A1") + 1, "0000") & ".pdf"
Sheets("List1").Range("A1") = Sheets("List1").Range("A1") + 1

Při provedení se vždy zvýší verze. serial

Takto jak to máš to půjde pouze makrem.
Pokud bys rozbalovací seznamy udělal klasicky tak se můžeš inspirovat tu

http://wall.cz/index.php?m=topic&id=14510

Nebude lepší to ukládat pod datumem a časem,
001,002... je nic neříkající.

"e:\test\" & Format(Now, "yyyy.mm.dd-hh.mm.ss") & ".pdf"

A nebylo jednoduší ty prvky rovnou umístit do listu, když se tam stejně vkládají?
Jinak jsem s tím zkoušel různé věci a vše šlo v poho.

Tak nejspíš to bude dělat ta hvězdička před datumem ve formátu buněk datumu, pokud se změní formát buněk v listu Hárok1 tak se zobrazují normální čísla.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje