LibreOffice Calc - Makra
OnlyOffice - offline
www.onlyoffice.com/desktop
xlsx
xls
OpravitCiselneBunkySDesetinnouTeckou
🎯 Cíl - Účel:
Bezpečně nahradit desetinné tečky za čárky a převést hodnoty zpět na čísla, ale pouze v buňkách obsahujících čistě číselné hodnoty (ať jako text, nebo číslo) v LibreOffice.
🔍 Vstupní rozsah:
List: aktuálně aktivní
Sloupce: A–Y (0–24)
Řádky: 0–1000 (lze změnit)
📋 Struktura kroků:
Analýza dat
Projde všechny buňky a spočítá ty, které obsahují: desetinnou tečku
a po nahrazení tečky čárkou dávají číselný formát (IsNumeric).
Dotaz na potvrzení akce
Pokud byly takové buňky nalezeny, zobrazí dotaz: „Nalezeno X buněk. Chceš je převést do CZ formátu?“
Převod hodnot
Nahrazuje tečku za čárku, převádí výsledek na číslo (CDbl),
ukládá jako číselnou hodnotu (setValue),
nastavuje formát na standardní číselný (NumberFormat = 0).
Závěrečné hlášení
Vypíše počet opravených buněk a název listu.
🔒 Ochrana dat:
Nezasahuje do textů obsahujících slova, znaky, jednotky, data apod.
Nepřepisuje prázdné ani nenačitatelné buňky.
🟢 Použitelné pro lokalizace, kde je čárka desetinným oddělovačem.
Makro má cca 80 řádků
------------ začátek Makra ------------
Sub OpravitCiselneBunkySDesetinnouTeckou()
Dim oDoc As Object, oSheet As Object
Dim oCell As Object
Dim sText As String, sProKontrolu As String
Dim dValue As Double
Dim iRow As Long, iCol As Long
Dim iLastRow As Long
Dim pocetKandidatu As Long, pocetOpraveno As Long
Dim odpoved As Integer
Dim jmenoListu As String
oDoc = ThisComponent
oSheet = oDoc.CurrentController.ActiveSheet
jmenoListu = oSheet.Name
iLastRow = 1000
' Najdi počet čistě číselných buněk s tečkou
For iRow = 0 To iLastRow
For iCol = 0 To 24
oCell = oSheet.getCellByPosition(iCol, iRow)
If oCell.Type = 1 Then ' číslo
sText = oCell.getFormula()
ElseIf oCell.Type = 2 Then ' text
sText = Trim(oCell.getString())
Else
sText = ""
End If
If sText <> "" And InStr(sText, ".") > 0 Then
sProKontrolu = Replace(sText, ".", ",")
If IsNumeric(sProKontrolu) Then
pocetKandidatu = pocetKandidatu + 1
End If
End If
Next iCol
Next iRow
If pocetKandidatu = 0 Then
MsgBox "List: " & jmenoListu & Chr(10) & _
"Nebyly nalezeny žádné čistě číselné hodnoty s tečkou.", 64, "Konec"
Exit Sub
End If
odpoved = MsgBox("List: " & jmenoListu & Chr(10) & _
"Nalezeno " & pocetKandidatu & " buněk s čistě číselnou hodnotou s tečkou." & Chr(10) & _
"Chceš je převést do CZ formátu?", 36, "Potvrď akci")
If odpoved <> 6 Then Exit Sub
' Proveď převod
For iRow = 0 To iLastRow
For iCol = 0 To 24
oCell = oSheet.getCellByPosition(iCol, iRow)
If oCell.Type = 1 Then
sText = oCell.getFormula()
ElseIf oCell.Type = 2 Then
sText = Trim(oCell.getString())
Else
sText = ""
End If
If sText <> "" And InStr(sText, ".") > 0 Then
sProKontrolu = Replace(sText, ".", ",")
If IsNumeric(sProKontrolu) Then
On Error Resume Next
dValue = CDbl(sProKontrolu)
If Err = 0 Then
oCell.NumberFormat = 0
oCell.setValue(dValue)
pocetOpraveno = pocetOpraveno + 1
End If
On Error GoTo 0
End If
End If
Next iCol
Next iRow
MsgBox "List: " & jmenoListu & Chr(10) & _
"Opraveno: " & pocetOpraveno & " číselných buněk.", 64, "Hotovo"
End Sub
------------ konec Makra ------------
--------------------------------------------------------------------------
Makro:
Vyhledat ve dvou listech a Sloučit do 3. různě umístěné řádky podle názvu země
Makro SloucitZemeDoList3Final v LibreOffice Calc
slučuje data o zemích ze dvou listů („List_1“ a „List_2“) do třetího listu („List_3“).
Hlavním cílem je najít odpovídající země v obou seznamech, spojit jejich informace na jeden řádek a zaznamenat, zda bylo spárování úspěšné.
Podrobný popis hlavní logiky
1. Inicializace a příprava
Makro si načte tři listy: List_1, List_2, List_3 (ten vytvoří, pokud neexistuje).
Vymaže celý obsah List_3.
Zkopíruje první čtyři řádky (např. hlavičky) z obou listů do List_3, včetně barvy písma.
2. Zjištění rozsahu dat
Určí, kde končí data v List_1 (dle sloupce A) a List_2 (dle sloupce B).
3. Hlavní slučovací smyčka
Pro každý řádek od 4. dál v List_1:
Normalizuje název země (bez diakritiky, malými písmeny, ořízne mezery).
Zkopíruje data ze sloupců A–K (0–10) do List_3.
Hledá odpovídající zemi ve sloupci B v List_2, rovněž po normalizaci.
Pokud ji najde:
Zkopíruje data ze sloupců 0–5 z List_2 do sloupců 11–16 v List_3.
Označí řádek jako „OK“.
Pokud ji nenajde:
Vloží text „bez dat z tradingeconomics.com“ do sloupců 18–19.
4. Závěrečná zpráva
Po dokončení vypíše počet úspěšně spárovaných a nespárovaných řádků.
Funkce Normalize(s)
Tato pomocná funkce:
Odstraní nežádoucí znaky (neviditelné mezery, tabulátory, nové řádky),
Převede text na malá písmena,
Odstraní českou diakritiku (např. „č“ → „c“),
Slouží ke srovnání zemí bez ohledu na odlišnosti v zápisu.
MACRO má celkově 126 řádků.
------------ začátek Makra ------------
Sub SloucitZemeDoList3Final()
Dim oDoc As Object
Dim oSheet1 As Object, oSheet2 As Object, oSheet3 As Object
Dim lastRow1 As Long, lastRow2 As Long
Dim i As Long, j As Long, k As Long
Dim zeme1 As String, zeme2 As String
Dim nalezeno As Boolean
Dim startRow As Long: startRow = 4
Dim radek3 As Long
Dim c1 As Object
Dim c2 As Object
oDoc = ThisComponent
oSheet1 = oDoc.Sheets.getByName("List_1")
oSheet2 = oDoc.Sheets.getByName("List_2")
' Vytvořit List_3 pokud neexistuje
On Error Resume Next
oSheet3 = oDoc.Sheets.getByName("List_3")
If oSheet3 Is Nothing Then
oDoc.Sheets.insertNewByName("List_3", 2)
oSheet3 = oDoc.Sheets.getByName("List_3")
End If
On Error Goto 0
' Vymazat List_3
oSheet3.getCellRangeByPosition(0,0, oSheet3.Columns.Count-1, oSheet3.Rows.Count-1).ClearContents(7)
' Přenést řádky 0–3 z obou listů
For i = 0 To startRow - 1
For k = 0 To 10
c1 = oSheet1.getCellByPosition(k, i)
With oSheet3.getCellByPosition(k, i)
.String = c1.String
.CharColor = c1.CharColor
End With
Next k
For k = 0 To 5
c2 = oSheet2.getCellByPosition(k, i)
With oSheet3.getCellByPosition(11 + k, i)
.String = c2.String
.CharColor = c2.CharColor
End With
Next k
Next i
' Najít konce dat
lastRow1 = startRow
Do While oSheet1.getCellByPosition(0, lastRow1).String <> ""
lastRow1 = lastRow1 + 1
Loop
lastRow2 = startRow
Do While oSheet2.getCellByPosition(1, lastRow2).String <> ""
lastRow2 = lastRow2 + 1
Loop
radek3 = startRow
Dim uspesne As Long: uspesne = 0
Dim nenalezene As Long: nenalezene = 0
For i = startRow To lastRow1 - 1
zeme1 = Normalize(oSheet1.getCellByPosition(0, i).String)
nalezeno = False
' Přenos A–K
For k = 0 To 10
c1 = oSheet1.getCellByPosition(k, i)
With oSheet3.getCellByPosition(k, radek3)
.String = c1.String
.CharColor = c1.CharColor
End With
Next k
' Hledání v List_2
For j = startRow To lastRow2 - 1
zeme2 = Normalize(oSheet2.getCellByPosition(1, j).String)
If zeme1 = zeme2 Then
For k = 0 To 5
c2 = oSheet2.getCellByPosition(k, j)
With oSheet3.getCellByPosition(11 + k, radek3)
.String = c2.String
.CharColor = c2.CharColor
End With
Next k
nalezeno = True
Exit For
End If
Next j
If nalezeno Then
oSheet3.getCellByPosition(18, radek3).String = "OK"
uspesne = uspesne + 1
Else
oSheet3.getCellByPosition(18, radek3).String = "bez dat z"
oSheet3.getCellByPosition(19, radek3).String = "tradingeconomics.com"
nenalezene = nenalezene + 1
End If
radek3 = radek3 + 1
Next i
MsgBox "Přenesení do List_3 dokončeno:" & Chr(10) & _
" - spárováno: " & uspesne & Chr(10) & _
" - nenalezeno: " & nenalezene, 64, "Hotovo"
End Sub
Function Normalize(s As String) As String
Dim aDiak As String, bBez As String, i As Integer, c As String
aDiak = "áčďéěíňóřšťúůýžÁČĎÉĚÍŇÓŘŠŤÚŮÝŽ"
bBez = "acdeeinorstuuyzACDEEINORSTUUYZ"
s = Replace(s, Chr(160), " ")
s = Replace(s, Chr(9), " ")
s = Replace(s, Chr(10), "")
s = Replace(s, Chr(13), "")
s = Trim(s)
s = LCase(s)
For i = 1 To Len(aDiak)
c = Mid(aDiak, i, 1)
s = Replace(s, c, Mid(bBez, i, 1))
Next i
Normalize = s
End Function
------------ konec Makra ------------
Cituji kousek z návodu:
Nápověda LibreOffice Basic
https://help.libreoffice.org/latest/cs/text/sbasic/shared/main0601.html?DbPAR=BASICTato část nápovědy obsahuje popisy nejběžnějších funkcí LibreOffice Basic. Podrobnější informace získáte na wiki v LibreOffice BASIC Programming Guide.
Práce s LibreOffice Basic
Programování v LibreOffice Basic
Běhové funkce
Záznam makra
Vytvoření dialogového okna v aplikaci Basic ...
excel xls xlsx odt
