Otestujte Imcon V1.
Můžete si to uložit mezi moje Makra Standard (nad všemi moduly) pouze s deklarací Public takto :
Public Sub Usporadej
Dim iVar, iVal as Integer : Dim sVal as string : Dim a(iVal,3) as Variant
SH = ThisComponent.Sheets(SheetIndex)
oCellCursor = SH.createCursor()
oCellCursor.gotoStartOfUsedArea( False )
SR = oCellCursor.getRangeAddress().StartRow
SC = oCellCursor.getRangeAddress().StartColumn
oCellCursor.gotoEndOfUsedArea( False )
ER = oCellCursor.getRangeAddress().EndRow
EC = oCellCursor.getRangeAddress().EndColumn
oRange = SH.getCellRangeByPosition(SC,SR,EC,ER)
vDescriptor = oRange.createReplaceDescriptor()
iVar = -1
For i = ER To SR Step - 1
For j = 4 To EC Step 2
IF SH.getCellByPosition(j,i).String = "" Then
GoTo Hopsasa
End If
iVar = iVar + 1
ReDim Preserve a(iVar,3)
a(iVar,0) = SH.getCellByPosition(SC,i).String
a(iVar,1) = SH.getCellByPosition(SC+1,i).String
a(iVar,2) = SH.getCellByPosition(j,i).String
SH.getCellByPosition(j,i).String = ""
a(iVar,3) = SH.getCellByPosition(j+1,i).Value 'Tady pozor očekáváme číslo ale může to být jinak (CSV ap.)
SH.getCellByPosition(j+1,i).String = ""
Hopsasa:
Next j
ii = 1
For jj = i + 1 To i + iVar
radky = SH.rows
radky.insertByIndex(jj,1) ' vlož na pozici prvního řádku dva nové (pozice řádku, počet nových řádků)
SH.getCellByPosition(SC ,jj).String = a(ii, 0)
SH.getCellByPosition(SC+1,jj).String = a(ii, 1)
SH.getCellByPosition(SC+2,jj).String = a(ii, 2)
SH.getCellByPosition(SC+3,jj).Value = a(ii, 3) 'Tady pozor očekáváme číslo ale může to být jinak (CSV ap.)
ii = ii + 1
Next jj
ReDim a(0,3)
iVar = 0
ii = 0
Next i
End Sub
Není to složité ale ladil jsem to 3 hodiny. Makro je postaveno tak, že by mělo nastartovat kdekoliv nad daty. Tedy start klidně na úseku C5:BA180. V listě nesmí být jiná data nežli zpracovávaná. Při testech jsem testoval i prázdné řádky mezi daty.
Zlobilo to, takže jsem to ukončil s tím, že data musí startovat na A1 tak jak ukazuje vzor. Jednotlivé řádky mohou být různě dlouhé. Tohle chodí snad dobře.
Horší je to v případě, že by Vám vadila rychlost zpracování. Lze to postavit celé do array a bylo by to řádově rychlejší. To jsem vzdal kvůli ladění ale mohu dodělat.
Může tam být problém s čísly. Každý sudý sloupec počínaje sloupcem "D" je deklarován jako číslo. Může se stát že v originále budou hodnoty ve formátu textu (nejčastěji importy z CSV). Tohle se dá snadno řešit :
přepsáním SH.getCellByPosition(j+1,i).Value
na tvar SH.getCellByPosition(j+1,i).String
Samozřejmě potom je potřeba udělat českou notaci čísel. To je ale jiná kapitola. Když byste potřeboval také toto, nebo něco dalšího - napište.
Otestujte nejprve s těmi simulovanými daty a pak na datech ostrých.
Editoval neutr (14. 7. 2019 15:51:03)
Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ