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

Příspěvky uživatele

Áno podobne

Sub Makro()
Range("A1").End(xlToRight).Activate
ActiveCell.EntireColumn.Insert
ActiveCell.Offset(0, 1).EntireColumn.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Offset(0, 1).ClearContents
Range("A1").Select
Application.CutCopyMode = False
End Sub

Stačí si zaznamenať makro, tak ako potrebuješ. Tak som na to prišiel.

Selection.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Prilož súbor.

No tu sa to aktualizuje. Ale asi je vhodné to potom vyfiltrovať.

Alebo kontingenčnú tabuľku.

Veď je to iba niekoľko klikov.
Ak nechceš makrá, tak asi potom použiť iný program ako excel.

Rozšírený filter

Sub Makro()
Range("A1").End(xlDown).Activate
ActiveCell.EntireRow.Insert
ActiveCell.Offset(1, 0).EntireRow.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Offset(1, 0).ClearContents
Range("A1").Select
Application.CutCopyMode = False
End Sub

Prípadne druhý riadok nahradiť týmto

ActiveSheet.UsedRange.Cells(1, 1).End(xlDown).Activate

S podmieneným formátovaním to nejde. To by asi bolo trochu zložitejšie.
Najjednoduchšie by bolo to podmienené formátovanie nahradiť makrom.
Ale ak nepriložíš tvoj súbor, tak je to skôr veštenie.

Sub Makro1()
x = 0
For Each bunka In Intersect(Selection, ActiveSheet.UsedRange)
If (bunka.Interior.Color <> 16777215) Then x = x + 1
Next
MsgBox x
End Sub
Vyznač si stlpec a spusti makro

Aj bielu farbu považuješ za farbu?

Trochu som to upravil.
Ale ak to chceš použiť priamo v liste, tak prečo nepoužiješ funkciu =ZLEVA(A1;2)? Alebo anglicky =LEFT(A1;2)

Function smazat_nesmazat(Retezec As String)as string
Dim x as string
if len(Retezec)=3 then x=left(retezec,2) else x=retezec
End If
smazat_nesmazat=x
End Function
Ale stačí ti to aj takto
Function smazat_nesmazat(Retezec As String)as string
smazat_nesmazat=left(retezec,2)
End Function

Sub AktualizaceCasu()
UserForm1.Label5.Caption = Format(tCas * 24 * 3600, "#")
NextTick = Now + TimeValue("00:00:01")
tCas = tCas + TimeValue("00:00:01")
Application.OnTime NextTick, "AktualizaceCasu"
End Sub

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse