Příspěvky uživatele

prkld
Sub Zmaz_radky(Tabulka As ListObject, Sloupec As String, Hodnota)
Dim Hodnoty(), Radku As Long, i As Long, Oblast As Range

With Tabulka.ListColumns("abc").DataBodyRange
Radku = .Rows.Count
If Radku = 1 Then
ReDim Hodnoty(1 To 1, 1 To 1)
Hodnoty(1, 1) = .Value
Else
Hodnoty = .Value
End If

For i = 1 To Radku
If Not IsEmpty(Hodnoty(i, 1)) And Hodnoty(i, 1) = Hodnota Then
If Oblast Is Nothing Then Set Oblast = .Rows(i) Else Set Oblast = Union(Oblast, .Rows(i))
End If
Next i
End With

If Not Oblast Is Nothing Then Oblast.Delete Shift:=xlUp
End Sub

Sub Vymaz()
Zmaz_radky Worksheets("Hárok1").ListObjects("Tabuľka1"), "abc", 0
End Sub

Vymazalo hodnoty a riadku ostanú, alebo odstránilo celé riadky?
Je to tabuľka alebo Tabuľka (lebo pri Tabuľke treba myslieť na ponechanie posledného ostávajúceho riadku napr. kvôli vzorcom)?
Od ktorého riadku sa má začať?

Veď o tom píšem, keď to máte červené, znamená to, že je tam nepovolený zápis kód, a keď ste nič iné nemenili okrem textu, tak nedovolený zápis budú medzery medzi riadkami.
Tu máte príklad + overenie adresára.

Tá cesta je správna? Existuje? Lebo makro nerieši vytvorenie neexistujúcej cesty.
Keď ste to skopírovala, zmazala ste medzery medzi riadkami, alebo Vám ostali riadky červené? Kopírovanie kódu z fóra vkladá medzi riadky medzery, a keďže tu je riadok rozdelený podčiarknikom, musí byť spojitý (bez prázdnych riadkov medzi daným príkazom).

Nemáte Total Commander? Tam označíte, Ctrl+M, dáte nahradiť "." a potom "," za "nič".
Dá sa samozrejme aj makrom. Keď píšete hromadne, tak myslíte tak, že si chcete určiť hlavný adresár napr. "C:\leden\" a premenuje všetky podadresáre?

EDIT:
Sub Premenuj(Cesta As String)
Dim objFLD As Object, Chyb As Long
On Error Resume Next
For Each objFLD In CreateObject("Scripting.FileSystemObject").GetFolder(Cesta).SubFolders
objFLD.Name = Replace(Replace(objFLD.Name, ",", ""), ".", "")
If Err.Number <> 0 Then Chyb = Chyb + 1: Err.Clear
Next objFLD
On Error GoTo 0
MsgBox IIf(Chyb = 0, "Všetky adresáre premenované.", "Niektoré adresáre neboli premenované (" & Chyb & ")."), IIf(Chyb = 0, vbInformation, vbCritical)
Set objFLD = Nothing
End Sub

Sub pokus()
Premenuj "e:\Download\1\"
End Sub

Číselné typy nie sú objekty, a teda sa nenastavujú cez Set. A ešte k tomu Integer! Ten má obmedzenie na 32767. Na farby potrebujete Long.

EDIT: A ešte pozerám, že tam vkladáte český vzorec. To nejde do Formula1. To sa dá iba do FormulaLocal, ale podmienený formát takú možnosť nemá. Tam treba iba ENG ekvivalent vzorca vkladať. Možnosť by bola to prekonvertovať cez FormulaLocal nejakej nepotrebnej bunky alebo cez dočasný definovaný názov. Mám sa Vám na to mrknúť?
Hmm, vlastne ani to nepôjde. Lebo ak spustíte na SK alebo EN verzii Excelu vloženie CZ vzorca, síce ako FormulaLocal, výsledok bude rovnaký - nefunkčnosť, lebo "Local" je na EN Office predsa EN, a pod.

EDIT2: No a ešte tam máte ďalšiu zradu. Indexovanie podmienených formátov. Nemôžete používať stále index 1. To sa mení podľa toho, koľko formátov zasahuje do daného rozsahu. Jednoduchšie, prehľadnejšie a menej náchylné k chybe bude priame nastavenie hneď pri vytváraní PF.
Private Sub Workbook_Open()
'Vymazani a naslednem nastaveni podmineneho formatovani

Dim ERR As String
Dim OK As String
Dim X As String
Dim Uvozovka As String
Dim CERVENA As Long
Dim ZELENA As Long
Dim MODRA As Long

Uvozovka = """"
ERR = "ERR"
OK = "OK"
X = "X"

CERVENA = RGB(255, 0, 0)
ZELENA = RGB(0, 255, 0)
MODRA = RGB(0, 0, 255)

With List2
.Cells.FormatConditions.Delete

.Range("A2:A99999").FormatConditions.Add(Type:=xlExpression, Formula1:="=LEN($A2)>17").Interior.Color = vbRed 'CERVENA
.Range("B2:B99999").FormatConditions.Add(Type:=xlExpression, Formula1:="=AND(LEN($B2)<>4;$B2<>"""")").Interior.Color = vbRed 'CERVENA
.Range("A2:A99999").FormatConditions.Add(Type:=xlExpression, Formula1:="=$H2=" & Uvozovka & ERR & Uvozovka & "").Interior.Color = vbRed 'CERVENA
.Range("A2:J99999").FormatConditions.Add(Type:=xlExpression, Formula1:="=$I2=" & Uvozovka & OK & Uvozovka & "").Interior.Color = vbGreen 'ZELENA
.Range("A2:J99999").FormatConditions.Add(Type:=xlExpression, Formula1:="=$I2=" & Uvozovka & X & Uvozovka & "").Interior.Color = vbBlue 'MODRA
End With
End Sub

Ako ešte vidíte, zrovna červená, zelená a modrá farba (a ešte iné) majú svoju konštantu, ktorú Excel rovno pozná a môžete použiť tie. Ak chcete ľubovoľnú farbu mixovať, samozrejme použite to RGB(). V opačnom prípade potom zmažte aj definície aj nastavenie tých premenných farieb.

Skúste maticový vzorec (Ctrl+Shift+Enter):
=INDEX(B2:B7;MATCH(TRUE;EXACT(D2;A2:A7);0))
=INDEX(B2:B7;POZVYHLEDAT(PRAVDA;STEJNÉ(D2;A2:A7);0))

Príklad - PowerQuery

Príklad takého súboru je ... ?
Ktorý list?
Aký rozsah dát?
Koľko je asi tých súborov?
...
Treba informácie, bez toho sa nedá urobiť nič.

Private Sub Workbook_Open()
With List1
.Cells.FormatConditions.Delete
.Range("B2:B99").FormatConditions.Add Type:=xlExpression, Formula1:="=AND(LEN($B2)<>4;$B2<>"""")"
.Range("B2:B99").FormatConditions(1).Interior.Color = 255
End With
End Sub

Neviem či som to pochopil. Skúste taký stav ukázať v prílohe. Akože sa hľadá najbližšia nižšia séria v kalkulation!B:B, podľa toho čo je zadané v List1!C:C ?

A Vy máte tie dáta, čo sú v inom súbore, zoradené, tak ako je naznačené? Teda že presne sedia trojriadky s pozíciami v tomto súbore? Alebo je potrebné pozíciu dohľadávať, a nieje to tak, ako je ukázané.
Priložte ukážku zdrojovej tbl - ten druhý súbor (bez citlivých dát).

-Máte zošit save2.xlsm
-Iba jeden list "List1", a ten chcete exportovať ako IKM (TXT). Iné listy tam niesú?
-V ňom chcete kliknúť na čudlík, a spustené makro sa opýta na názov a umiestnenie toho IKM.
- "nedokazu prevzit jmeno a cestu ulozeni do dalsich veci jako je zavreni daneho sesitu a nasledneho prepsani koncovky" ??? zatvorenie akého zošitu ?
- "a dané excely se zavrou" ??? aké excely ? Veď máte otvorený len ten jeden zošit save2.xlsm!

EDIT1: 11.2.2021 12:58
Prípadne skúsiť niečo iné:
Sub SAVEjako()
Dim Soubor As String, S As String
Dim H()
Dim x As Integer, y As Long
Soubor = Application.GetSaveAsFilename(InitialFileName:="D:\DATA_import.ikm", FileFilter:="Textový soubor IKM (*.ikm), *.ikm", Title:="Export IKM")
If Soubor = "False" Then Exit Sub
H = List1.UsedRange.Value
For y = 1 To UBound(H, 1)
For x = 1 To UBound(H, 2)
S = S & IIf(x = 1, vbNullString, vbTab) & H(y, x)
Next x
S = S & vbNewLine
Next y
Open Soubor For Output As #1
Print #1, S
Close #1
End Sub
len tam treba dbať aj na formát dát.

EDIT2: alebo takto:
Sub SAVEjako2()
Dim Soubor As String
Soubor = Application.GetSaveAsFilename(InitialFileName:="D:\DATA_import.ikm", FileFilter:="Textový soubor IKM (*.ikm), *.ikm", Title:="Export IKM")
If Soubor = "False" Then Exit Sub
Application.DisplayAlerts = False
Application.ScreenUpdating = False
List1.Copy
ActiveWorkbook.SaveAs Filename:=Soubor, FileFormat:=xlText
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Porovnajte si oba výsledky.

"--("6")" prevedie číslo ako text "6" na skutočné číslo 6.

Je to možné, že Galéria v mobile nezobrazí korektne "priesvitnú" farbu PNG (možno bezfarbé bunky {ColorIndex=xlNone} uloží ako priesvitné???).
Skúste použiť fintu Graf-->JPG. Teda sa dočasne vytvorí list s prázdnym grafom, do ktorého sa vloží skopírovaná oblasť ako obrázok, a graf už umožňuje uložiť ako JPG. dočasný list s grafom sa zmaže. Už to tu bolo určo riešené, len sa mi to nechce hľadať. Mrk na mrexcel.
Nepamätám si ako to bolo s kvalitou.
Vložíte prílohu JPG a súbor zmažete napr. pomocou Kill.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje