MS Excel

Zdravím,
nemůžu přijít na to, jak sloučit více sloupců do dvou sloupců a tak bych Vás chtěl poprosit o pomoc. Pro ukázku přikládám obrázek. Problém je, že nebudu vědět jak dlouhé sloupce budou (každý může být jinak dlouhý) a ani nebudu vědět kolik sloupců v řadě bude (maximálně však +-50), vždy však bude vedle sloupce Jméno sloupec Věc. Výsledek je ukázaný ve sloupcích H a I, může však být kdekoliv, klidně na novém Listě.
Děkuji

Zaslat odpověď >

xlnc(24.2.2017 17:45)#035102

Zdroj na prvním, výsledek na druhém listu.

Sub Spojovacka()

Dim wshZdroj As Worksheet
Dim wshCil As Worksheet

Dim rngOblast As Range
Dim rngTempBunka1 As Range
Dim rngTemp As Range

Dim intTemp As Integer
Dim intRadek As Integer
Dim intPocetSloupcu As Integer

'zamezeni prekreslovani a prepoctu
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'prirazeni zdrojoveho listu do promenne
Set wshZdroj = Worksheets(1)

'prirazeni ciloveho listu do promenne
Set wshCil = Worksheets(2)

'vycisteni ciloveho listu
wshCil.UsedRange.Clear

'prirazeni kopirovane oblasti do promenne
Set rngOblast = wshZdroj.Cells(1).CurrentRegion

With wshCil

'kopie na druhy list
rngOblast.Copy .Cells(1)

'pocet sloupcu
intPocetSloupcu = .Range(.Cells(1), _
.Cells(1).End(xlToRight)).Cells.Count

'prvni volny radek prvni podoblasti s parovymi hodnotami
intRadek = .Range(.Cells(1), .Cells(1).End(xlDown)).Cells.Count + 1

'zpracovani podoblasti s parovymi hodnotami
For i = 2 To intPocetSloupcu \ 2

'prvni bunka podoblasti
Set rngTempBunka1 = .Cells(1, 2 * i - 1)

'pocet paru v podoblasti
intTemp = .Range(rngTempBunka1, rngTempBunka1.End(xlDown)).Cells.Count - 1

'prevzeti podoblasti
Set rngTemp = rngTempBunka1.Offset(1, 0).Resize(intTemp, 2)

'presun podoblasti
rngTemp.Cut Cells(intRadek, 1)

'nasledujici volny radek
intRadek = intRadek + intTemp

Next i

'vycisteni radku hlavicek
.Range(.Cells(1, 3), .Cells(1, 3).End(xlToRight)).Clear

End With

'povoleni prepoctu a prekreslovani
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Subcitovat

elninoslov(24.2.2017 18:08)#035103

Ja som to robil cez pole. Bol ste rýchlejší.

Příloha: zip

35103_spoj-stlpce.zip (17kB, staženo 43x)

citovat

elninoslov(24.2.2017 19:10)#035104

Zo srandy som skúsil vypotiť brutálny megavzorec namiesto makra. Teraz nastavené na 1000 hodnôt. Výpočtová doba sa ako tak dá zniesť...

Příloha: zip

35104_spoj-stlpce-megavzorcom.zip (28kB, staženo 40x)

citovat

sbm(24.2.2017 20:40)#035105

Díky, jste borci :)citovat

xlnc(24.2.2017 22:34)#035108

elninoslov napsal/a:

Ja som to robil cez pole. Bol ste rýchlejší.Příloha: 35103_spoj-stlpce.zip (17kB, staženo 3x)

To vaše není programový kód, ale Matrix :-D Ne vážně, tohle uživatelům nemůžete naservírovat :-D. Jo, máte nesporně programátorského ducha, copak o to, ale ... no a ty Goto trošku bolí.citovat

xlnc(24.2.2017 22:42)#035109

U sebe mám taky řešenou podobnou úlohu vzorci. Je to masakr. U mě ŘÁDEK, POČET2, INDEX, POZVYHLEDAT, ODKAZ, NEPŘÍMÝ.ODKAZ, jedna pomocná buňka za každý (dvoj)sloupec.citovat

elninoslov(25.2.2017 3:03)#035119

"xlbx" napsal/a:

To vaše není programový kód, ale Matrix :-D Ne vážně, tohle uživatelům nemůžete naservírovat :-D. Jo, máte nesporně programátorského ducha, copak o to, ale ... no a ty Goto trošku bolí.

Keď ja tie polia používam tak rád ...

citovat

xlnc(25.2.2017 16:27)#035129

elninoslov napsal/a:

"xlbx" napsal/a:To vaše není programový kód, ale Matrix :-D Ne vážně, tohle uživatelům nemůžete naservírovat :-D. Jo, máte nesporně programátorského ducha, copak o to, ale ... no a ty Goto trošku bolí.Keď ja tie polia používam tak rád ...

Nejde o pole, ono se to v tom ani nepozná, ale o čitelnost.citovat

MePExG(25.2.2017 21:01)#035133