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

Příspěvky uživatele

dnes sa mi uz nechce premyslat, ale isiel by som na to asi pomocnym listom, do ktoreho by som makrom skopiroval iba viditelne riadky, a tie potom porovnal

takto?

neviem presne ci som presne pochopil o co ide ak si pipnu dvakrat, PS: dufam ze nocne sa nerobia asi by si v tom mal trochu bordel (je tam iny datum prichodu a iny datum odchodu co toto makro neriesi)

pracuje to aj v inych adresaroch, skus si to skontrolovat + asi musis prepisat vzorce na vypocet hodin. inac v databze mas chyby - napr id 12 ma myslim 6.2 dva prichody

skontroluj to riadkovanie, na dalsie sa este pozrem

musisi mat povolene makra (Nastroje, Moznosti, Zabezpeceni maker - ja mam nizke), potom v excely Alt +F11 (otvoris editor VBA), insert, module - do bielej obrazovky nakopirujes text ktory som poslal, zavres editor VBA. od teraz mas tuto funkciu medzi ostatnymi funkciami v zalozke Vlastni (funkcia bude dostupna iba v ak budes mat otvoreny subor do ktoreho si to vlozil - da sa to urobit aj globalne ale ja som to este nepotreboval tak po tom nepatram), vyberes funkciu oznacis bunkuv ktorej je text a bunku v ktorej je pismeno ktoreho pocet chces zistit

vzorce mi nejdu spravil som jednoduchu funkciu ak chces - zatial berie iba jednu bunku alebo zlucene bunky


Function Pocet_vyskitov(Text, Pismeno) As String

Dim i As Long, pocet As Integer
pocet = 0
For i = 1 To Len(Text)
Select Case Mid(Text, i, 1)
Case Pismeno
pocet = pocet + 1
Case Else

End Select
Next i

Pocet_vyskitov = pocet

End Function

skus tento kod, ZALOHUJ SI ORGINALY, "undo alebo zpet" nefubguje, je to na 54 riadkov, este skusam elegantnejsiu verziu , ale to az potom co toto bude OK

ak by to neslo budem potrebovat zopar orginal pomenovanych listov


Sub spoj_listy()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets(1).Select
Sheets.Add
Sheets(1).Select

x = 1
For Each llist In ActiveWorkbook.Sheets
Cells(x, 1).Value = llist.Name
x = x + 1
Next llist

Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("B1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],SEARCH(""_"",RC[-1])-1)"
Selection.AutoFill Destination:=Range(Cells(1, 2), Cells(ActiveSheet.UsedRange.Rows.Count, 2)), Type:=xlFillDefault

Range(Cells(1, 2), Cells(ActiveSheet.UsedRange.Rows.Count, 2)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

For riadok = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(riadok, 1).Value = Cells(riadok - 1, 1).Value Then
Rows(riadok).Delete
riadok = riadok - 1
End If
If Cells(riadok, 1).Value = "" Then GoTo kk
Next riadok
kk:

pocetlistov = ActiveSheet.UsedRange.Rows.Count
For riadok = 1 To pocetlistov
Sheets(1).Select
menolistu = Cells(riadok, 1).Value
Sheets(2).Select
Sheets.Add
Sheets(2).Select
Sheets(2).Name = menolistu
Next riadok

Sheets(1).Select
ActiveWindow.SelectedSheets.Delete

For x = 1 To pocetlistov
For Each llist In ActiveWorkbook.Sheets
If InStr(1, llist.Name, "_") = 0 Then GoTo ky
If Sheets(x).Name = Left(llist.Name, InStr(1, llist.Name, "_") - 1) Then
llist.Activate
Range(Cells(1, 1), Cells(54, 11)).Select
Selection.Copy
Sheets(x).Activate
Cells(Range("h36556").End(xlUp).Row + 2, 1).Select
ActiveSheet.Paste
End If
ky:
Next llist
Next x

End Sub

Vidis , jednoduche a funkcne a o to ide

vov, tak tu som skoncil - pri tom list2 Ti neviem poradit , ale kto by uz zadaval tak blby nazov listu ?

pozrem na to , nebude problem spojit to ale zachovat strankovanie pre tlac asi bude pre mna trochu oriesok - no nic uvidime

opač


Sub hh() 'vloží nový list
Application.ScreenUpdating = False
x = Application.InputBox("Zadejte jméno nového listu", "Vložení nového listu")
If x = vbNullString Or x = False Then
Exit Sub
End If

For Each llist In ActiveWorkbook.Sheets
If llist.Name = x Then
MsgBox ("meno listu uz existuje")
Exit Sub
End If
Next llist

Sheets.Add after:=Worksheets(1)
ActiveSheet.Name = x

Sheets(x).Select

Application.ScreenUpdating = True

End Sub

Autor makra Radek Jureček

aby sa makro spustilo samo premenuj ho na Auto_open()
uprav si v nom veci co potrebujes, neviem ako ostatnym ale mne makra pracujuce s inymi subormy (otvaranie, ukladanie) pracuju iba ak su niekde na disku C (moje dokumenty, plocha, c: ..........) , ak chcem aby isli aj na inych diskoch musim mat priamo nadefinovanu cestu (nie premenná v kode makra - v tomto makre je to premenná)

mne vzorce velmi nevonaju , ale ked chces tu mas makro. da sa tam jednoducho upravit odkial kam to chces kopirovat

skus

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse