Dobrý den,
5888_pokus.zip
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
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
RSS nejnovější články