Excel VBA

změnit řádky 10 a 11 takto :

For i = 1 To InputRng.Rows.Count Step 3
OutRng.Resize(1, 3).Value = Array(InputRng.Cells(i, 1).Value, InputRng.Cells(i + 1, 1).Value, InputRng.Cells(i + 2, 1).Value)

Trochu sem kód předělal, je přidána konstanta (Sloupcu), která určuje počet sloupců, do kterých se bude vybraná oblast "transportovat". Nyní stačí pro změnu počtu sloupců přepsat jen číslo konstanty a není potřeba editovat samotný kód.

[code]

Sub MoveRange()
Const Sloupcu As Byte = 5 číslo, které určí do kolika sloupců se vybraná oblast rozdělí
Dim rng As Range
Dim InputRng As Range, OutRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set InputRng = InputRng.Columns(1)
For i = 1 To InputRng.Rows.Count Step Sloupcu
OutRng.Resize(1, Sloupcu).Value = Application.Transpose(InputRng.Cells(i, 1).Resize(Sloupcu).Value)
Set OutRng = OutRng.Offset(1, 0)
Next
End Sub

[/code]

Edit: nemáte někdo tip jak zde vkládat kód aby nechocházelo k jeho mršení? Jinak byl odstraněn apostrof u komentáře, který je u konstanty. Nutno doplnit!

Ještě přidám úpravu předchozího kódu. Předchozí kód vracel chybovou hodnotu při zadání např. 22 hodnot do 5 sloupců.

Sub MoveRange()
Const Sloupcu As Byte = 5 číslo, které určí do kolika sloupců se vybraná oblast rozdělí
Dim Resiz As Byte
Dim InputRows As Integer
Dim Modulo As Byte
Dim NumCyc As Integer
Dim rng As Range
Dim InputRng As Range, OutRng As Range
Dim i As Integer, x As Integer

xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set InputRng = InputRng.Columns(1)

InputRows = InputRng.Rows.Count
Modulo = InputRows Mod Sloupcu
NumCyc = Int(InputRows / Sloupcu)
Resiz = Sloupcu

For i = 1 To InputRows Step Sloupcu
If x = NumCyc Then Resiz = Modulo
OutRng.Resize(1, Resiz).Value = Application.Transpose(InputRng.Cells(i, 1).Resize(Resiz).Value)
Set OutRng = OutRng.Offset(1, 0)
x = x + 1
Next
End Sub

PS: Díky za tag, na to další zadání se podívám.

PS2: hm, tak i v tomto tagu dochází k odmazávání znaků kua

K tomu kódu pro Latex. Zádrhel bych hledal v části kódu s podmínkou:

If m >= 15 Then
MsgBox ("This Macro cantt handle more than 15 rows. Sorry.")
Exit Sub
End If

Zkus změnit číslo 15 na 21, ještě bych odstranil to rovnítko.

Promiňte, ale na začátečníka se pouštíte proklatě vysoko. První část dotazu se nedá odpovědět takto jednoduše a v jednom odstavečku. Makro by nemělo dělat víc, než jednu činnost. Makrům, které provádějí více činností, ajťáci říkají špagetový kód a ten se považuje za školáckou chybu. Takové makro se časem pouze a jedině komplikuje a jednou přijde den, kdy se v něm nevyzná ani sám autor.

A zde je moje odpověď na vaši doplňující otázku. Co s tou patnáctkou?

If m >=15 Then
MsgBox ("This Macro cantt handle more than 15 rows. Sorry.")
Exit Sub
End If
*

Česky řečeno, když m je větší než 15 , potom napiš hlášku, že řádků nesmí být víc než 15 a ukonči makro příkazem Exit Sub.

Změňte patnáctku na nějaké větší číslo a problém je vyřešený. Jen pozor na strukturální chybu. Vaše >=15 znamená, že váš Exit Sub proběhne i v případě čísla 15. K patnáctému řádku se nikdy nedostanete. Proto vám radím, naučte se strukturovat programy tak, abyste nemusela používat povel Exit Sub. To je hodně tvrdé lámání přes koleno.

Správně by kód měl vypadat takto

If m>15 then

MsgBox ("This Macro cant handle more than 15 rows. Sorry.")

Else

... sem přijdou postupná volání ostatních maker

End If

Vidíte ten rozdíl? Když m>15, program skočí na hlášku MsgBox, kód ostatních maker vůbec neproběhne a vy nemusíte používat tvrdý konec Exit Sub.