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

MS Excel

Téma: Dosaď dnes jako hodnotu

Zaslal/a Raders486 12.12.2016 20:56

Ahoj.
Potřeboval bych poradit.
Pokud je ve sloupci A číslo 1 až 3 tak vlož do sloupce B dnešní datum jako hodnotu a skoč na další řádek ve sloupci A, který obsahuje číslo 1 až 3.
Toto vše opakuj až do posledního ohraničeného řádku ve sloupci A

Pokud již ve sloupci B datum je skoč na další řádek ve sloupci A, který obsahuje číslo 1 až 3.
Toto vše opakuj až do posledního ohraničeného řádku ve sloupci A

Snad je to srozumitelné.

Pokud by bylo potřeba vzorovou tabulku doplním.

Děkuji

Zaslat odpověď >

---

Strana:  1 2 3   další »

xlnc(12.12.2016 21:13)#033783

To umí:

a) Robot Karel
b) Velmistr šachu
c) Filtr a Ctrl+Enter
d) Kilometr dlouhý kód VBAcitovat

Raders486(12.12.2016 21:25)#033784

Jistě že kilometr dlouhý kód VBA pokud je člověk začátečník, ale čekal jsem tedy že se ozve jiný machr.citovat

Raders486(12.12.2016 21:35)#033785

Každopádně jsem myslel něco jako toto, ale nevím kde mám chybu
Dim Range As Range
Set Range = Columns("A:A")

i = 1
For Each i In Range("A:A")
'For counter = 1 To Rng.Rows.Count
If Range.Cells(i) > 0 Then 'Pokud aktuální buňka ve sloupci "A" obsahuje číslo větší než, nula tak skoč do buňky vedle ActiveCell.Offset(0, 1)
Range.Cells(i) = ActiveCell.Offset(0, 1).Range("A1").Select

If ActiveCell > 1 Then 'Pokud tato buňka obsahuje text tak se vrať do bunky vedle a o řádek níže ActiveCell.Offset(1, -1)
ActiveCell.Offset(0, -1).Range("A1").Select
Else
ActiveCell.FormulaR1C1 = "=NOW()" 'Pokud buňka neobsahuje text, vlož NOW(), zkopíruj a vlož jako text
ActiveCell.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End If
Else
i = i + 1
End If
Nextcitovat

xlnc(12.12.2016 21:54)#033786

To on se jiný machr ozve, já se snažil naznačit, že VBA je nejspíš zbytečnost. Nesoudím vás za to, jaký jste nebo nejste začátečník ve VBA. Každý nějak začínal. Ale že nejspíš ve VBA ještě nemáte co dělat, protože vymýšlíte kolo.citovat

syd(12.12.2016 22:14)#033787

Zdravim Radku,

tim vasim VBA kodem urcite ne..
Ale treba takto:


Sub RK()
Dim ws As Worksheet
Dim lr As Long
Set ws = ActiveSheet
lr = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
ws.AutoFilterMode = False

With ws.Range("A1:C" & lr)
.AutoFilter field:=1, Criteria1:=Array("1", "2", "3"), Operator:=xlFilterValues
.AutoFilter field:=2, Criteria1:="="
ws.Range("B2:B" & lr).SpecialCells(12).Value = Date
End With
ws.AutoFilterMode = False
End Sub

A to s tou podminkou, ze sloupec 'C' obsahuje data az do posledniho radku tabulky (tedy neobsahuje prazdne bunky).

sydcitovat

marjankaj(12.12.2016 22:21)#033788

No mne sa celkom páči možnosť c). Je to oveľa lepšie ako kilometrový kód VBA.

Dáš automatický filter.
Vyberieš hodnoty 1 2 a 3
V stĺpci B vyznačíš myškou príslušnú oblasť
dáš CTRL + ;
a na záver CTRL + ENTER

Akurát CTRL + ; nefunguje vo všetkých verziách excelu. Napríklad mne to v excel 2007 nejde.
Už som na to prišiel, pred CTRL+; treba stlačiť F2

No syd na to urobil makro.citovat

Raders486(12.12.2016 22:44)#033789

Tak jsem se s tím popral a pokud je ve sloupci A číslo tak se vedle dosadí datum a vybere buňku ActiveCell.Offset(1, -1).Range("A1").Select

A zde to skončí.
Nejsem však schopen zapsat tu opakovačku, aby to tak prošlo celou tabulku.
Sub Makro8() 'OD KDY JE URGENT

Dim Range As Range
Set Range = Columns("A:A")
i = i + 1
For Each i In Range
'For counter = 1 To Rng.Rows.Count
If ActiveCell.Value > 0 Then 'Pokud aktuální buňka ve sloupci "A" obsahuje číslo větší než, nula tak skoč do buňky vedle
ActiveCell.Offset(0, 1).Select
If ActiveCell.Value > 1 Then 'Pokud tato buňka obsahuje text tak se vrať do bunky vedle a o řádek níže ActiveCell.Offset(1, -1)
ActiveCell.Offset(1, -1).Range("A1").Select
Else
ActiveCell.FormulaR1C1 = Date 'Pokud buňka neobsahuje text, vlož NOW(), zkopíruj a vlož jako text
ActiveCell.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next
i
End If
End Subcitovat

Raders486(12.12.2016 22:46)#033790

Lol Syd už odpověděl aniž bych si všiml.
Moc děkuji a jdu vyzkoušet.citovat

Raders486(12.12.2016 23:11)#033791

Tak jsem vyzkoušel a nejede tak docela.
V příloze aktuální tabulka. Rutinu jsem hodil do sešitu a na tlačítko.

Jediné co udělá, tak že B1 Poznámky přepíše na dnešní datum.
Potřeboval bych, aby to dnešní datum dosadil do všech prázdných buněk ve sloupci B kde je ve sloupci A nějaká hodnota.

Ale i tak děkuji za ochotu.

Příloha: 33791_od-kdy-urgent.rar (56kB, staženo 22x)

citovat

AL(12.12.2016 23:12)#033792

syd napísal v podstate to, čo už predtým navrhoval xlnc v bode c) Inými slovami, stačilo nahrať makro pre verziu c navrhnutú Petrom. Nič proti, ja len konštatujem skutkový stav veci, čím nechcem znižovať sydove schopnosti. Každopádne, pokiaľ sa nejedná o opakujúcu sa úlohu, tak makro je zbytočné, nakoľko sa jedná o problém, ktorý sa dá riešiť na pár kliknutí myšou..
@ marjankaj: pokiaľ máš záujem jukni sem, písal som, ako funguje/nefunguje to ctrl+;:http://wall.cz/index.php?m=topic&id=33516#post-33524citovat

Strana:  1 2 3   další »

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse