sloučení prázných buňěk

karlitos · 22. 9. 2010 21:24:32

Dobrý den
Mám problém, na který jsem zatím ještě nenašel řešení. Mám jednu velikou tabulku - vzniklou importem CVS souboru a ta má mnoho prázných polí. Ty sice umím sloučit do jedné buňky - ale vzhledem k rozměrům tabulky : 15 000 x 25 polí to nemůžu dělat ručně. Hledám tedy nějaký způsob jak sloučit všechny bloky prázných buněk vždy do jednoho bloku.
Našel jsem možné řešení - v podobě makra pro excel, ale jedná se o dost starý kód a calc ho nepodporuje.
Čerpal jsem ze stránek http://www.mvps.org/dmcritchie/excel/merge.htm a jedná se o následující makro :

Option Explicit
'David McRitchie, http://www.mvps.org/dmcritchie/code/merge.txt 2002-05-31

Sub MergeRxR()
   '-- Merge cells in multiple selected areas Row by Row  ---
   '    limited to the usedrange  (Ctrl+End)
   ' D.McRitchie, 2002-05-31 in merge.htm
  Dim rng As Range
  Dim rw As Range, ix As Long
  Set rng = Intersect(Selection, ActiveSheet.UsedRange)
  If rng Is Nothing Then
     MsgBox "nothing in usedrange to be merged"
     GoTo done
  End If
  Dim i As Long, j As Long
  For i = 1 To Selection.Areas.Count
      For j = 1 To Selection.Areas(i).Rows.Count
        Application.DisplayAlerts = False
        Selection.Areas(i).Rows(j).MergeCells = True
        Application.DisplayAlerts = True
      Next
  Next
done:
End Sub

Sub MergeRxR_Join()
   '-- Merge cells in multiple selected areas Row by Row  ---
   '    limited to the usedrange  (Ctrl+End)
    '   JOIN contents of cells before merging
   ' D.McRitchie, 2002-05-31 in merge.htm
  Dim Str As String, ii As Long
  Str = ""
  Dim rng As Range
  Dim rw As Range, ix As Long
  Set rng = Intersect(Selection, ActiveSheet.UsedRange)
  If rng Is Nothing Then
     MsgBox "nothing in usedrange to be merged"
     GoTo done
  End If
  Dim i As Long, j As Long
  For i = 1 To Selection.Areas.Count
      For j = 1 To Selection.Areas(i).Rows.Count
        Application.DisplayAlerts = False
        Str = ""   '... concatenate cells for this row in selection
        For ii = 1 To Selection.Areas(i).Rows(j).Columns.Count
          Str = Str & " " & Selection.Areas(i).Rows(j).Columns(ii)
        Next ii
        Str = Mid(Str, 2)
        Selection.Areas(i).Rows(j)(1) = Str
        Selection.Areas(i).Rows(j).MergeCells = True
        Application.DisplayAlerts = True
      Next
  Next
done:
End Sub

Sub MergeCxC()
   '-- Merge cells in multiple selected areas Column by Column ---
   '    limited to the usedrange  (Ctrl+End)
   ' D.McRitchie, 2002-05-31 in merge.htm
  Dim rng As Range
  Dim rw As Range, ix As Long
  Set rng = Intersect(Selection, ActiveSheet.UsedRange)
  If rng Is Nothing Then
     MsgBox "nothing in usedrange to be merged"
     GoTo done
  End If
  Dim i As Long, j As Long
  For i = 1 To Selection.Areas.Count
      For j = 1 To Selection.Areas(i).Columns.Count
        Application.DisplayAlerts = False
        Selection.Areas(i).Columns(j).MergeCells = True
        Application.DisplayAlerts = True
      Next
  Next
done:
End Sub


Sub UnMergeSelected()
   '-- same as  format, cells, alignment (tab),  (turn off) Merge Cells
   Selection.MergeCells = False
End Sub

Sub SetupG20()
   Cells.MergeCells = False
   Range("A1:G20").Select
   Application.Run "personal.xls!MarkCells"  'see join.htm
End Sub

Sub MergeEmpty_A()
'David McRitchie, 2004-05-27, programming
    With Cells
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
    End With
    On Error GoTo done
    Cells(Rows.Count, 2).End(xlUp).Activate
    ActiveCell.Offset(0, -1).Activate
backthere:
    Range(ActiveCell.Address, _
       ActiveCell.End(xlUp).Address).Select
    Selection.Merge
    ActiveCell.Offset(-1, 0).Activate
    GoTo backthere
done:
End Sub

Mimojiné je problém v datovém typu Range a navíc potřebuji jenom subrutinu Sub MergeEmpty_A(). Bouhžel je pro mě visualbasic velká neznámá, ale třeba se najde někdo kdo by mi uměl poradit.

díky předem K

lp. · 23. 9. 2010 11:04:23

Zkuste trochu lépe popsat co potřebujete. Uvedená procedura je trochu v rozporu s tím, co píšete nahoře - k neprázdné buňce ve sloupci A připojuje prázdné buňky pod ní. A dělá to špatně (přesněji pouze pro jednu konkrétní strukturu dat: v případě, že poslední buňka v sloupci A není prázdná nebo pod neprázdnou buňkou nejsou prázdné buňky, tak je smaže).

karlitos · 23. 9. 2010 11:10:02

Dobry den

Mnohokrat dekuji za odpoved. Potrebuji aby se kazdy blok prazdnych bunke sloucil do jedne.
Importoval jsem databanku 455 zaznamu prez CVS soubor. Protoze se jedno o tabulku s vnorenymi tabulkami je pro kazdy zaznam treba v 1. sloupci nejake identifikator (accession numb.) a v tretim je 5 zaznamu pod sebou. Coz mi logicky prida ctyri radky pod prvni.
Zkusim sem hodit screenshot.

Prvni screen je pred a druhy po. Jelikoz ne vsechny sloupce maji stejnou delku tak by byl asi vhodny nasledujici algorithmus :
--- 1.---
# projdi vsechny sloupce zleva do prava
# pokud najdes prazdnou bunku - sluc ji se vsemi prazdnymi pod ni
---2.---
# projdi vsechny radky odshora dolu
# pokud najdes prazdnou bunku sluc ji se vsemi napravo jez maji stejnou velikost

Musim pouzivat calc pro vizualizaci a visuslbasic je pro me velka neznama, jsem spiz prez algorithmiku tak si s tim moc neumim poct. Kdybyste me mohli pomoct budu moc rad, diky K

Editoval karlitos (23. 9. 2010 11:29:14)

lp. · 23. 9. 2010 22:48:03

Pokud jedinou funkcí sloučených buněk jsou čáry kolem prázdných ploch, dá se to udělat bez programování a bez slučování - vypnete zobrazování mřížky, zvolíte "Najít a nahradit" (ctrl-f), "více voleb", zatrhnete regulární výrazy, do políčka Hledat zadáte ".*" (bez uvozovek, hledá se cokoliv)
zvolíte "Najít vše". Vybrané buňky naformátujete podle potřeby (ohraničení).

Pokud chcete ještě orámovat prázdná místa, nainstalujete si rozšíření SpecialCells, Vyberete oblast s daty, Nástroje, přídavky, contents, nastavíte rozsah, vyberete Blank cells, vybrané buňky opět orámujete podle nálady.

Výsledek bude vizuálně shodný s ukázkou a zabere to pár vteřin.

Marrtt · 21. 3. 2015 06:56:03

Dobrý den
Prosím o radu:

tohle funguje
Sub slouceni
Dim Doc As Object
dim oblast as object
doc = thiscomponent
strana_2 = doc.sheets(2)
oblast = strana_2.getCellrangebyname("a1:c1") ==== tady mám ale problém - viz níže
oblast.merge(true)
end sub
---
potřeboval bych oblast sloučení deklarovat dynamicky, protože předem nevím, na kterém řádku se mi vyskytne
---
příkaz
oblast = strana_2.getCellByPosition(0,0,0,2) nebo s proměnnými
oblast = strana_2.getCellByPosition(a,b,c,d)
ignoruje a sloučení neprovede. Je vůbec možné deklarovat pro sloučení s proměnnými?
Dělám něco špatně? Deklarace? jiná chyba?
Děkuju
Martin

neutr · 21. 3. 2015 10:26:33

Koukal jsem na různá fóra a řešení jsem nenašel. Doporučují například nepřímo nejprve sloučit obsahy buněk a pak sloučit pomocí merge.
Tam to uváděli jako manuální metodu, ale dá se to udělat také makrem - zavedeme vzorec na sloučení, zpětně ho načteme do paměti, smažeme původní obsahy, sloučíme a vložíme už jen hodnoty po sloučení.
Manuální metoda to umožňuje tak jak potřebujete - sloučí vše z buněk. Například při nahrávání makra se to podaří, ale vyskočí dialog stejný jako při manuálním slučování.
Technicky půjde o nepovinný parametr, který by se měl přidat k UNO zápisu. To by se mělo dát dohledat. Stejně tak musí existovat podobný parametr pro Basic. Věřím, že se dá někde najít, ale hledat je možné mnoho hodin či dní.

Takže pokud potřebujete věcně sloučit, použijte makro se vzorcem, který nejprve vše sloučí a pak spojte nejlépe už vyprázdněné buňky.
Použijte deklaraci s CellByPosition - protože hledání prázdných, nebo potřebných budete navazovat na inkrementaci.
Pokud Vám to tak vyhovuje, ale neumíte si s tím poradit pošlete vzor sešitu s tím co se má sloučit - tedy podmínku a rozsahy.

Marrtt · 21. 3. 2015 11:58:29

Obsah je pouze v prvním sloupci slučovaného pole (jde jen o grafické roztažení buňky pro dlouhý text a nemohu/nechci roztáhnout sloupec) Mám nápad, jak to provést - viz přiložený calc. Vložím nový řádek na požadovanou pozici a do něj vložím zkopírovaný řádek nad ním (má správný formát)a teprve potom do něj vložím hodnoty. Je to trochu prasárna, ale v konkrétním případě mi to nenaruší nic v sešitu. Výřez ze sešitu zde https://app.box.com/s/kcnms2fja3vmwc9zdztd5zorn1seewg7
používám tento cyklus pro plnění (resp. doplńování stávajícího) seznamu v sešitu hodnotami z Listboxu a přidáním pořadového čísla

x = last_acc_dep.value - 4
for k = x to ubound(fin_acc.model.finacc_num_box.StringItemList())
strana_1.rows.insertByIndex(last_acc_dep.value,1)
acc_cell = Strana_1.getcellbyposition(1,last_acc_dep.value)
acc_cell.string = fin_acc.model.finacc_num_box.stringitemlist(k)
acc_ord_num = Strana_1.getcellbyposition(0,last_acc_dep.value)
acc_ord_num.value = k+1
arrea = strana_1.getCellByposition(1,last_acc_dep.value,3,last_acc_dep.value)
arrea.merge(true)
arrea.cellbackcolor = rgb (255,255,205)
arrea = strana_1.getCellByposition(0,last_acc_dep.value)
arrea.cellbackcolor = rgb (255,255,205)
last_acc_dep.value = last_acc_dep.value + 1
next k

lp. · 22. 3. 2015 01:04:23

Zkuste metodu

strana_1.getCellRangeByPosition(......

Marrtt · 22. 3. 2015 05:29:18

To Ip:
to je přesně to, o čem tu mluvím - při použití metody deklarace

arrea = strana_1.getCellByposition(1,last_acc_dep.value,3,last_acc_dep.value)
arrea.merge(true)

se příkaz neprovede.
Nevím proč, ale dynamickou deklaraci s proměnnými program prostě ignoruje, aniž by ohlásil nějakou chybu

Marrtt

Marrtt · 22. 3. 2015 05:31:28

Nebo je to jinak? vidím rozdíl v syntaxi až teď, pardon...

Marrtt · 22. 3. 2015 05:38:16

To Ip
Děkuju. funguje to. Byl jsem po ránu ještě slepý a nevšiml jsem si rozdílu v deklaraci.

OpenOffice.cz - web věnovaný kancelářským balíkům OpenOffice.org

#1 22. 9. 2010 21:24:32

sloučení prázných buňěk

#2 23. 9. 2010 11:04:23

Re: sloučení prázných buňěk

#3 23. 9. 2010 11:10:02

Re: sloučení prázných buňěk

#4 23. 9. 2010 22:48:03

Re: sloučení prázných buňěk

#5 21. 3. 2015 06:56:03

Re: sloučení prázných buňěk

#6 21. 3. 2015 10:26:33

Re: sloučení prázných buňěk

#7 21. 3. 2015 11:58:29

Re: sloučení prázných buňěk

#8 22. 3. 2015 01:04:23

Re: sloučení prázných buňěk

#9 22. 3. 2015 05:29:18

Re: sloučení prázných buňěk

#10 22. 3. 2015 05:31:28

Re: sloučení prázných buňěk

#11 22. 3. 2015 05:38:16

Re: sloučení prázných buňěk

Zápatí