Добрый день , помогите пожалуйста со скриптом , у меня есть плейлист музыки и мне нужно через каждых пять треков вставлять разных 5 рекламных аудио ролика. во вложении пример на первом листе оригинал а на втором нужный результат.
Получается начиная со второй строки через 14 строк создать 2 пустые строки и вставить в строку 1 текст "#EXTINF:0,audio-1.mp3" в строку 2 текст "audio-1.mp3" потом опять через 14 строк создать 2 пустые строки и вставить в строку 1 "#EXTINF:0,audio-2.mp3" в строку 2 "audio-2.mp3"
Sub КислотныйДиджей()
Dim sh1 As Worksheet
Set sh1 = ActiveSheet
Dim sh2 As Worksheet
Set sh2 = ActiveSheet
Dim y As LongPtr
Dim arr As Variant
With sh1
y = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
arr = .Range(.Cells(1, 1), .Cells(y, 1))
End With
y = (UBound(arr, 1) - 1) * 1.3 + 1
Dim brr As Variant
Dim u As Long
Dim j As Long
Dim i As Byte
ReDim brr(1 To y, 1 To 1)
brr(1, 1) = arr(1, 1)
u = 1
j = 1
For y = 2 To UBound(arr, 1)
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = arr(y, 1)
i = i + 1
If i = 15 Then
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = "#EXTINF:0,audio-" & j & ".mp3"
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = "audio-" & j & ".mp3"
u = u + 1
j = j + 1
i = 0
End If
Next
sh2.Cells(1, 10).Resize(UBound(brr, 1), 1) = brr
End Sub
Option Explicit
Sub AddAdvertising()
Const MAX_ADV As Integer = 3
Dim i As Long, rnd As Integer
With ActiveWorkbook.Sheets("Лист1")
rnd = MAX_ADV
For i = .Cells(Rows.Count, 1).End(xlUp).Row + 2 To 10 Step -1
If i Mod 15 = 2 Then
.Rows(i).Insert Shift:=xlDown
.Rows(i).Insert Shift:=xlDown
.Rows(i).Insert Shift:=xlDown
.Range("A" & i) = "#EXTINF:0,audio-" & rnd & ".mp3"
.Range("A" & i + 1) = "audio-" & rnd & ".mp3"
If rnd = 1 Then
rnd = MAX_ADV
Else
rnd = rnd - 1
End If
End If
Next i
End With
End Sub
Sub КислотныйДиджей()
Const Nmax = 4
Dim sh1 As Worksheet
Set sh1 = ActiveSheet
Dim sh2 As Worksheet
Set sh2 = ActiveSheet
Dim y As Long
Dim arr As Variant
With sh1
y = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
arr = .Range(.Cells(1, 1), .Cells(y, 1))
End With
y = (UBound(arr, 1) - 1) * 1.3 + 1
Dim brr As Variant
Dim u As Long
Dim j As Byte
Dim i As Byte
ReDim brr(1 To y, 1 To 1)
brr(1, 1) = arr(1, 1)
u = 1
j = 1
For y = 2 To UBound(arr, 1)
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = arr(y, 1)
i = i + 1
If i = 15 Then
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = "#EXTINF:0,audio-" & j & ".mp3"
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = "audio-" & j & ".mp3"
u = u + 1
j = j + 1
If j > Nmax Then j = 1
i = 0
End If
Next
sh2.Cells(1, 10).Resize(UBound(brr, 1), 1) = brr
End Sub
В этом варианте количество указывать не нужно. Можно использовать не только числа в именах audio-?.mp3.
Код
Sub КислотныйДиджей()
Dim arrAudio As Variant
arrAudio = Array("audio-1.mp3", "audio-2.mp3", "audio-AAA.mp3")
Dim sh1 As Worksheet
Set sh1 = ActiveSheet
Dim sh2 As Worksheet
Set sh2 = ActiveSheet
Dim y As Long
Dim arr As Variant
With sh1
y = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
arr = .Range(.Cells(1, 1), .Cells(y, 1))
End With
y = (UBound(arr, 1) - 1) * 1.3 + 1
Dim brr As Variant
Dim u As Long
Dim j As Byte
Dim i As Byte
ReDim brr(1 To y, 1 To 1)
brr(1, 1) = arr(1, 1)
u = 1
j = LBound(arrAudio)
For y = 2 To UBound(arr, 1)
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = arr(y, 1)
i = i + 1
If i = 15 Then
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = "#EXTINF:0," & arrAudio(j)
u = u + 1
If u > UBound(brr, 1) Then Exit For
brr(u, 1) = arrAudio(j)
u = u + 1
j = j + 1
If j > UBound(arrAudio) Then j = LBound(arrAudio)
i = 0
End If
Next
sh2.Cells(1, 10).Resize(UBound(brr, 1), 1) = brr
End Sub