< návrat zpět

MS Excel


Téma: řádky rss

Zaslal/a 30.8.2011 13:49

JAKDobrý den,

mám napsané toto makro:

Sub vlozeniRadku()
x = Selection.Address
PSl = Selection.Columns.Count
BRad = ActiveCell.Row
PRad = Selection.Rows.Count * 2
ERad = PRad + BRad - 1
Do
BRad = BRad + 1
Rows(BRad).Select
ActiveCell.EntireRow.Insert shift:=xlDown
BRad = BRad + 1
Loop Until BRad >= ERad
Range(x).Resize(PRad, PSl).Select

Dim i As Long

For i = 2 To Cells(65000, 3).End(xlUp).Row
If StrComp(Cells(i, 5).Value, "") = 0 Then

Cells(i, 5).Value = "Promo okno"

End If
Next i

End Sub

Makro vkládá řádky. Do přílohy jsem dal soubor, kde je ukázka jak makro pracuje a jak by pracovat mělo. Poradíte někdo prosím. Děkuji.

Příloha: zip5888_pokus.zip (7kB, staženo 20x)
Zaslat odpověď >

#005889
avatar
Zkus:
Sub vlozeniRadku()
Dim Vyh As Boolean
x = Selection.Address
PSl = Selection.Columns.Count
Brad = ActiveCell.Row
PRad = Selection.Rows.Count * 2
erad = PRad + Brad - 1
Do
Call test(Vyh, CLng(Brad))
If Vyh Then
erad = erad - 1
Else
Brad = Brad + 1
Rows(Brad).Select
ActiveCell.EntireRow.Insert shift:=xlDown
End If
Brad = Brad + 1
Loop Until Brad >= erad
Range(x).Resize(PRad, PSl).Select

Dim i As Long

For i = 2 To Cells(65000, 3).End(xlUp).Row
If StrComp(Cells(i, 5).Value, "") = 0 Then

Cells(i, 5).Value = "Promo okno"

End If
Next i
End Sub
Sub test(Opo As Boolean, Typos As Long)
Opo = False
For Lypos = 1 To Cells(Typos, 200).End(xlToLeft).Column
If Cells(Typos, Lypos).MergeCells Then
If Not Cells(Typos + 1, Lypos).MergeCells Then
Opo = False
Else
Opo = True
End If
Exit Sub
End If
Next Lypos

End Sub

citovat
#005895
JAK
Díky moc 2citovat

Uživatelské menu

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

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

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

Aktivní diskuse

Výmaz řádku podle hodnoty v konkrétním sloupci

elninoslov • 7.2. 21:49

Výmaz řádku podle hodnoty v konkrétním sloupci

Alfan • 7.2. 14:02

Výmaz řádku podle hodnoty v konkrétním sloupci

Alfan • 7.2. 11:44

plán 12 h směn na celý rok

PE1PA • 6.2. 14:56

plán 12 h směn na celý rok

elninoslov • 6.2. 14:16

plán 12 h směn na celý rok

elninoslov • 6.2. 14:15

plán 12 h směn na celý rok

elninoslov • 6.2. 13:21