Příspěvky uživatele

Jj, už jsem použil váš soubor s tím přejmenováním.
Když zadám například 1234567, tak se RZ uloží.
Ale v RZ musí být minimálně jedno písmeno a to na druhé pozici.
U elektroauta jsou první dva znaky "EL".
Celkový počet znaků RZ je 7, ty na přání mají 8.
Šlo by to nějak zakomponovat do těch podmínek?
Děkuji.
Radek

@elninoslov
Zkusil jsem váš kod, ale vyskakuje mi tam tato chyba:
Set LO = wsKJ.ListObjects("DataKj") 'název Tabulky na listě kj

List má název "kj" a je na něm tabulka s názvem "DataKj"

Ostatním samozřejmě také děkuji.
Radek

Dobrý den,
mohli byste mi někdo , prosím, zeditovat níže uvedené makro?
V Dimenzi "kj" může být číslo nebo velké písmeno.
Měl jsem makro o vás tady z fóra na jméno a příjmení, ale tam jsem kontroloval jen to, že tam jsou jen písmena a první písmeno je velké.
Tady potřebuji:
buď číslo nebo velké písmeno a zároveň délka 7 znaků (alfanumerických).
Zkusil jsem to sám, ale zkolaboval jsem na číslech.
Přkládám i soubor.
Děkuji.
Radek

Sub Nova_KJ()

Dim kj As String
Dim jmeno As String
Dim radek As Long

On Error Resume Next 'pokud uživatel stiskne klávesu ESC, kód skočí do řádku s "Exit Sub"

Do
kj = InputBox("Zadejte novou RZ: (bez mezer, a speciálních znaků) - ukončit můžete klávesou ESC nebo kliknutím na křížek nebo na klávesu Cancel")

If Err.Number <> 0 Then 'pokud uživatel stiskne klávesu ESC, ukončí se makro
Exit Sub
End If

'jmeno = InputBox("Zadejte jméno: (bez mezer, čísel a speciálních znaků) - ukončit můžete klávesou ESC nebo kliknutím na křížek nebo na klávesu Cancel")

If Err.Number <> 0 Then 'pokud uživatel stiskne klávesu ESC, ukončí se makro
Exit Sub
End If

On Error GoTo 0 'vynulování chybového čísla

If kj = "" Then
Exit Sub
End If

If Not (IsUpper(kj) And _
IsNumeric(kj) And _
Len(kj) = 7 Or Len(kj) = 0 Or Len(kj) < 7) Then

'If Not (IsUpper(Left(prijmeni, 1)) And IsUpper(Left(jmeno, 1)) And _
' IsOnlyLowerCase(Right(prijmeni, Len(prijmeni) - 1)) And _
'IsOnlyLowerCase(Right(jmeno, Len(jmeno) - 1)) And _
'IsOnlyLetters(prijmeni) And IsOnlyLetters(jmeno) And _
'Len(prijmeni) > 1 And Len(jmeno) > 1) Then

MsgBox "Opravte RZ - (bez mezer, a speciálních znaků) - ukončit můžete klávesou ESC nebo kliknutím na křížek nebo na klávesu Cancel"
Else
If Sheets("kj").Range("A2") = "" Then
radek = 2
Else
radek = Sheets("kj").Range("A" & Rows.Count).End(xlUp).Row + 1
End If

Sheets("kj").Range("A" & radek).Value = kj
Exit Do
End If
Loop

With ThisWorkbook.Sheets("kj")
.Range("A2").Sort key1:=.Range("A2"), order1:=xlAscending, Header:=xlYes
End With

Dim ws As Worksheet
Dim lastRow As Long, i As Long, j As Long
Set ws = ThisWorkbook.Sheets("kj") 'název listu

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 2 To lastRow 'prochází každý řádek od 2. řádku až po poslední
For j = i + 1 To lastRow 'prochází každý řádek nad aktuálním řádkem
If ws.Cells(i, "A").Value = ws.Cells(j, "A").Value Then 'pokud jsou hodnoty v sloupci A stejné, vymaže řádek
ws.Rows(j).EntireRow.Delete
lastRow = lastRow - 1 'aktualizuje poslední řádek, protože byl odebrán řádek
j = j - 1 'decrementuje j, aby se při dalším průchodu prozkoumal nový řádek, na který se posunul
End If
Next j
Next i

MsgBox ("HOTOVO- nová RZ uložena")

End Sub

Function IsUpper(text As String) As Boolean
IsUpper = (text = UCase(text))
End Function

Function IsOnlyLowerCase(text As String) As Boolean
IsOnlyLowerCase = (text = LCase(text))
End Function

Function IsOnlyLetters(text As String) As Boolean
Dim i As Integer
For i = 1 To Len(text)
If Not (Asc(Mid(text, i, 1)) >= 65 And Asc(Mid(text, i, 1)) <= 90) And _
Not (Asc(Mid(text, i, 1)) >= 97 And Asc(Mid(text, i, 1)) <= 122) And _
Not (Asc(Mid(text, i, 1)) >= 138 And Asc(Mid(text, i, 1)) <= 254) Then
IsOnlyLetters = False
Exit Function
End If
Next i
IsOnlyLetters = True
End Function

Super díky za odpověď.
Já to předělávat nebudu, ať si to pustí na windows.
Každopádně děkuji.
Radek

Dobrý den,
s souboru, viz příloha, mám makro přes tlačítko na uložení do *.pdf.
Mám to tady od někoho od vás a funguje mi to super.
Nicméně, když to pošlu kolegovi, které má MacBook Pro tak po spuštění makra pro uložení do *.pdf mu hlásí tuto chybu:
„Run-time Error 429 ActiveX component cant create object"

Dá se to makro nějaku pravit, aby fungovalo i na MacOS nebo to nelze?
Děkuji.
Radek

Jj, v tomto konkrétním případě, tabulka "kj" nejsou.
Ale chtěl jsem řešit jiné tabulky, kde duplicity byly přes relace v Power Pivot a nevěděl jsem si rady.

Děkuji, jsem lama.
Já si totiž myslel, že když v tabulce "data" přidám ten sloupec "Vuz", nebudu muset používat relace v Power Pivot.
Já mám totiž relaci mezi tabulkou "kj" a tabulkou "data".
Akorát se budu muset ještě naučit v Power Pivot relace N:N, tedy ne jen 1:N.
Ještě jednou děkuji.
Radek

Dobrý den, chci se zeptat, zda tento může výrazně zpomalit načítání respektive aktualizaci Dat z Power Query?

let
currentKJ = [Kalkulační jednice],
matchingRow = Table.SelectRows(kj, each [Kalkulační jednice] = currentKJ),
matchingTypVozu = if Table.RowCount(matchingRow) = 1 then matchingRow{0}[Název kalkulační jednice] else ""
in
matchingTypVozu

Když jsem kod doplnil vložením do vytvořeného sloupce "Vuz" v tabulce "data" tak to bylo rychlé a viděl jsem výsledek.
Ale když jsem pak dal Zavřít a načíst, tak se to stále načítá... a trvá to stále dlouho a nemůže se to ukončit.
Soubor jsem zatím nedával, protože je veliký.
v té tabulce "data" jsou načteny roky z účetního deníku 2021, 2022 a 2023, takže jsou to desítky tisíc řádků.
Nicméně do doby vložení toho kodu mi vše běželo hladce :-)
Ten kod kontroluje sloupec "Kalkulační jednice" v tabulce "data" se sloupcem "Kalkulační jednice" v tabulce "kj". Pokud najde shodu, doplní do sloupce "Vuz" v tabulce "data" hodnotu ze sloupce "Název kalkulační jednice" z tabulky "KJ".
V tabulce "kj" nejsou ve sloupci "Kalkulační jednice" duplicity.
Děkuji.

Super, děkuji, takto stačí.
Radek

Jj, funguje je to.
Akorát, když zadávám data a chci přejít "šipkou" ze sloupce "D" de facto přes sloupec "E" do sloupce "F" a skočím do sloupce "E", automaticky se mi kurzor přesune do sloupce "A" o řádek níž.
Musím jedině kliknout do "F" myší.
Nejde to nějak ošetři, aby se ten sloupec "E" přeskočil v tom samém řádku, pokud se budu pohybovat šipkami?
Jde mi jen o komfort zadávání dat.
Ale každopádně děkuji.
Radek

Tak asi dělám něco fakt špatně...
Já to takto udělal.
Spíš si myslím, jestli nemám špatně to VBA?

Děkuji.
Ale nefunguje mi to.
To VBA jsem si zkopíroval a zkopíroval jsem i do mého sešitu ten list "switch".
Dovolí mi to přepsat buňku ve sloupci "E", kde mám vzorec.

Dobrý den,
můžete mi, prosím, někdo poradit, jak zamknout list, na kterém se zadávají data a list je ve formátu Tabulky?
Já potřebuji mít zamknuté pouze záhlaví, názvy sloupců a pak také buňky ve sloupci "E".
Označil jsem všechny buňky na listu a odemkl je.
Pak jsem označil buňky v záhlaví a zamkl je a totéž jsem udělal pro buňky ve sloupci "E", ale jen ty, které jsou teď "aktivní" - v řádku jsou data.
Pak jsem list zamkl.
Jenže při zadání data v prvním sloupci se automaticky nezmění rozsah Tabulky.
CO dělám špatně, a lze to vůbec?
Heslo je: 1234

Děkuji.
Radek

@lubo
Jj, to jsem právě taky zkoušel.
Nicméně jsem to musel vyřešit tím seznamem se středníkem.

Každopádně mi to přijde velmi nepraktické.
Ale předpokládám, že druhy MJ nebudeme měnit tak často :-)

Ještě jednou děkuji všem.
Radek

Jasně.
To asi budu muset udělat.
Já to chtěl mít přes Tabulku s ohledem na případné rozšíření.
Takhle budu muset vždycky upravovat.
Myslel jsem, že se to třeba bude dát vyřešit funkcí "stejné"
Ale i tak děkuji.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje