< návrat zpět

MS Excel

Téma: Dosaď dnes jako hodnotu rss

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
avatar
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
avatar
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
avatar
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
avatar
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
avatar
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
avatar
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
avatar
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
avatar
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
avatar
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: rar33791_od-kdy-urgent.rar (56kB, staženo 22x)
citovat
icon AL(12.12.2016 23:12)#033792
avatar
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)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

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.

On-line nástroje