• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

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

Zaslal/a MessiM 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

Zaslat odpověď >

---

MessiM(23.7.2017 16:12)#036958

A aby se to formát kopírovalo jen v případě sloupců - D,E,F,G,H ... citovat

marjankaj(23.7.2017 20:31)#036959

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

marjankaj(23.7.2017 21:14)#036960

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. citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse