< návrat zpět

MS Excel


Téma: VBA - rychlá úprava kopírování formátu rss

Zaslal/a 23.7.2017 16:03

Ahoj, v VBA jsme začátečník, ale nějak se s tím už nějaký ten pátek peru. Žádám vás o pomoc, mám VBA a potřeboval bych jej upravit, kde si zvolím nově vybrané řádky (to už mám) a ty by měly mít automaticky formát - ohraničení (například z řádku výše + v buňce ve sloupečku ("D") by bylo napsané velké V).

Zasílám své makro.
Sub pridani_variant()

Dim CalcMode As Long, EnableMode As Long, ScreenMode As Long
Dim lastrow As Integer, i As Integer
Dim pasterow As Byte, n As Byte

'kolik radku vlozit
pasterow = InputBox("Kolik variant chcete vložit?", "Počet nových variant", 1)

'puvodni nastaveni excelu
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
EnableMode = .EnableEvents
.EnableEvents = False
ScreenMode = .ScreenUpdating
.ScreenUpdating = False
End With

'prace s aktivnim listem
With ActiveSheet
'posledni radek v sl.A
lastrow = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row
'opakuj pro vsechny radky
For i = lastrow To 1 Step -1
'opakuj pocet vlozeni
For n = 1 To pasterow
'vlozeni radku za puvodni radek
.Rows(i + 17).EntireRow.Insert
Next n
Next i
End With
'vraceni nastaveni excelu
With Application
.Calculation = CalcMode
.EnableEvents = EnableMode
.ScreenUpdating = ScreenMode
End With

End Sub


Díky 1

Zaslat odpověď >

#036958
avatar
A aby se to formát kopírovalo jen v případě sloupců - D,E,F,G,H ... 1citovat
#036959
avatar
A nechceš začať s niečím jednoduchším?
Napríklad makrom vyplniť aktuálnu bunku hodnotou 1234?

Sub vypln()
ActiveCell = 1234
End Sub

Inak kód bez dát je na prd, keď nie je jasné, čo sa má kopírovať. Ako ho má niekto vyskúšať? A je zbytočne dlhý.citovat
#036960
avatar
No neviem, či ti pomôže toto makro.
Sub Makro1()
Dim pasterow As Long
Dim lastrow As Long
pasterow = InputBox("Kolik variant chcete vložit?", "Počet nových variant", 1)
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
Range(Rows(lastrow), Rows(lastrow).Offset(pasterow - 1)).EntireRow.Insert
Range(Cells(lastrow - 1, "D"), Cells(lastrow - 1, "H")).Copy _
Range(Cells(lastrow, "D"), Cells(lastrow, "D").Offset(pasterow - 1))
Range(Rows(lastrow), Rows(lastrow).Offset(pasterow - 1)).ClearContents
Range(Cells(lastrow, "D"), Cells(lastrow, "D").Offset(pasterow - 1)) = "V"
End Sub


Neviem aké sú vstupy a ani ako má vyzerať výstup. Ale keď som pozrel do čarovnej gule, tak som si pracne vytvoril súbor. Keďže je to moje know-how tak ho tu nebudem zverejňovať, aby mi ho niekto neukradol. Sú to citlivé údaje. 2citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje