Uprava macra

Od: Datum: 30.04.13 16:15 odpovědí: 5 změna: 07.05.13 14:16

Mám vytvořené nasledovné macro a potřebuju ho upravit, aby se červeně označená část macra provedlo na 2. - 402. řádku.

Sub Macro1()
Range("E2:E402").Select
Selection.Font.Bold = False
Range("h2:h402").Select
Selection.Font.Bold = False
Range("k2:k402").Select
Selection.Font.Bold = False
Range("n2:n402").Select
Selection.Font.Bold = False
Range("w2:w402").Select
Selection.Font.Bold = False
Range("y2:y402").Select
Selection.Font.Bold = False
Range("br2:br402").Select
Selection.Font.Bold = False
Range("bu2.bu402").Select
Selection.Font.Bold = False
Range("bx2:bx402").Select
Selection.Font.Bold = False
Range("ca2:ca402").Select
Selection.Font.Bold = False
Range("ck2:ck402").Select
Selection.Font.Bold = False
Range("cm2:cm402").Select
Selection.Font.Bold = False
Range("df2:df402").Select
Selection.Font.Bold = False
Range("dj2:dj402").Select
Selection.Font.Bold = False
Range("o2").Font.FontStyle = "bold"
Range("e2").Value = Range("a2").Value
Range("e2").Characters(Start:=Range("c2"), Length:=Range("d2")).Font.FontStyle = "bold"
Range("k2").Value = Range("a2").Value
Range("k2").Characters(Start:=Range("i2"), Length:=Range("j2")).Font.FontStyle = "bold"
Range("h2").Value = Range("b2").Value
Range("h2").Characters(Start:=Range("f2"), Length:=Range("g2")).Font.FontStyle = "bold"
Range("n2").Value = Range("b2").Value
Range("n2").Characters(Start:=Range("l2"), Length:=Range("m2")).Font.FontStyle = "bold"
Range("w2").Value = Range("r2").Value
Range("w2").Characters(Start:=1, Length:=Range("v2")).Font.FontStyle = "bold"
Range("y2").Value = Range("t2").Value
Range("y2").Characters(Start:=1, Length:=Range("v2")).Font.FontStyle = "bold"
Range("br2").Value = Range("bn2").Value
Range("br2").Characters(Start:=Range("bp2"), Length:=Range("bq2")).Font.FontStyle = "bold"
Range("bx2").Value = Range("bn2").Value
Range("bx2").Characters(Start:=Range("bv2"), Length:=Range("bw2")).Font.FontStyle = "bold"
Range("bu2").Value = Range("bo2").Value
Range("bu2").Characters(Start:=Range("bs2"), Length:=Range("bt2")).Font.FontStyle = "bold"
Range("ca2").Value = Range("bo2").Value
Range("ca2").Characters(Start:=Range("by2"), Length:=Range("bz2")).Font.FontStyle = "bold"
Range("ck2").Value = Range("ce2").Value
Range("ck2").Characters(Start:=Range("ci2"), Length:=Range("cj2")).Font.FontStyle = "bold"
Range("cm2").Value = Range("cg2").Value
Range("cm2").Characters(Start:=Range("ci2"), Length:=Range("cj2")).Font.FontStyle = "bold"
If Range("Dg2") = "" Then
Range("DF2").Select
Selection.Font.Bold = True
Range("Dj2").Select
Selection.Font.Bold = True
End If
End Sub


Seznam odpovědí:
 
moment čekejte prosím, probíhá přenos dat...
Zobrazení struktury odpovědí v otázce
Skrytí struktury odpovědí v otázce
Zobrazení struktury odpovědí v otázce

 

Odpovědi na otázku:
Datum: 01.05.13 09:51
avatar

Hmmmm. Žádné červené označení nevidím. Myslíte, že vaše makro bude někdo luštit? *ee*

Nepovídejte mi, že se v něm vyznáte.

Naučte se nejdříve tu nejzákladnější věc a vymažte všechny dvojice select-selection.

například na místě

Range("Dj2").Select
Selection.Font.Bold = True

má být

Range("Dj2").Font.Bold = True

atd.

A pak se naučte tu druhou základní věc. Jedno makro má provádět jen jednu činnost. Jedním makrem mažte formáty, druhým vkládejte hodnoty, třetím formátujte buňky a podobně.

Poté se makra spouští postupně z hlavního řídícího makra. Vypadá to takto :

Sub Makro()

call Makro1

call Makro2

call Makro3

end Sub

Tak. Udělejte co jsem vám poradil a potom budeme pokračovat.

Ohodnoceno: 0x
 
Od: spiny*
Datum: 01.05.13 18:25

Tady je moje upravené macro. Teď mi jde o to, aby macro2 proběhlo v řádcích 2 - 402. V každém řádku budou zdrojová data ve sloupci A, které se zkopírují do sloupců E,J z B do H,L z P do U,W z BL do BP,BV z BM do BS,BY z CC do CI,CK, kde dojde ke ztučnění textu na základě hodnot start a lenght. Text v bunkach DD,DH se ztuční, když buňka DE v daném řádku bude prázdná. Zdrojová data v každém řádku budou jiná.

Sub Makro()
Call Makro1
Call Makro2
End Sub
Sub Makro1()
Range("E2:E402,j2:j402,h2:h402,l2:l402,u2:u402,w2:w402,bp2:bp402,bv2:bv402,bs2:bs402,by2:by402,ci2:ci402,ck2:ck402,dd2:dd402,dh2:dh402").Font.Bold = False
End Sub
Sub Makro2()
Range("m1").Font.FontStyle = "bold"
Range("e2,j2").Value = Range("a2").Value
Range("e2").Characters(Start:=Range("c2"), Length:=Range("d2")).Font.FontStyle = "bold"
Range("j2").Characters(Start:=Range("c2"), Length:=Range("i2")).Font.FontStyle = "bold"
Range("h2,l2").Value = Range("b2").Value
Range("h2").Characters(Start:=Range("f2"), Length:=Range("g2")).Font.FontStyle = "bold"
Range("l2").Characters(Start:=Range("f2"), Length:=Range("k2")).Font.FontStyle = "bold"
Range("u2,w2").Value = Range("p2").Value
Range("u2,w2").Characters(Start:=1, Length:=Range("t2")).Font.FontStyle = "bold"
Range("bp2,bv2").Value = Range("bl2").Value
Range("bp2").Characters(Start:=Range("bn2"), Length:=Range("bo2")).Font.FontStyle = "bold"
Range("bv2").Characters(Start:=Range("bt2"), Length:=Range("bu2")).Font.FontStyle = "bold"
Range("bs2,by2").Value = Range("bm2").Value
Range("bs2").Characters(Start:=Range("bq2"), Length:=Range("br2")).Font.FontStyle = "bold"
Range("by2").Characters(Start:=Range("bw2"), Length:=Range("bx2")).Font.FontStyle = "bold"
Range("ci2,ck2").Value = Range("cc2").Value
Range("ci2,ck2").Characters(Start:=Range("cg2"), Length:=Range("ch2")).Font.FontStyle = "bold"
If Range("De2") = "" Then
Range("Dd2,Dh2").Font.Bold = True
End If
End Sub

Datum: 06.05.13 08:24
avatar

věc má háček. Makrem ztučněný text bude ztučněný na věčné časy, dokud jej zase makrem neodtučníte. Já bych vám na tomto místě poradil použít místo maker podmíněné formátování. Buňka se dá podmíněně naformátovat na základě hodnoty jiné buňky. Když je v jedné buňce "" potom je v jiné font bold.

Ohodnoceno: 0x
 
Od: spiny*
Datum: 06.05.13 17:56

Provádím ztučnění pouze části textu buňce, na to podmíněné formátování použít nelze, alespoň to neznám. Proto to provádím přes macro.

Datum: 07.05.13 14:16
avatar

oukej, popojedeme. Napsal jsem vám zkušební makro pro deset řádků, tak udělějte hokus pokus. Červené formátování je v makru proto, abychom na výsledek lépe viděli. Příkaz On Error Resume Next je ochrana proti kixnutí.

*

Sub Macro3()
On Error Resume Next
Dim PrvniBunka As Range, AktivniBunka As Range
Dim Start As Byte, Delka As Byte
Dim Linka As Integer, PocetLinek As Integer
Dim Text As String

Set PrvniBunka = Range("E2")
PocetLinek = 9 pozor, pocet linek se pocita od nuly

For Linka = 0 To PocetLinek
Set AktivniBunka = PrvniBunka.Offset(Linka, 0)
Text = AktivniBunka.Offset(0, -4)
Start = AktivniBunka.Offset(0, -2)
Delka = AktivniBunka.Offset(0, -1)
AktivniBunka.Value = Text
AktivniBunka.Characters(Start:=Start, Length:=Delka).Font.FontStyle = "Bold"
AktivniBunka.Characters(Start:=Start, Length:=Delka).Font.Color = vbRed
Next Linka
End Sub

Ohodnoceno: 0x
 

 

 

Přihlásit se k odběru odpovědí z této otázky:

Neneseme odpovědnost za správnost informací a za škodu vzniklou jejich využitím. Jednotlivé odpovědi vyjadřují názory jejich autorů a nemusí se shodovat s názorem provozovatele poradny Poradte.cz

 
Copyright © 2004-2016 Poradna Poradte.cz. Všechna práva na poradně Poradte.cz vyhrazena.