Вставить заданное число после всех элементов одномерного массива кратных заданному числу.

Option Explicit
Option Base 1
Sub MyProg()
 
Dim intMas() As Integer
Dim intCesl As Integer
Dim intSamm As Integer
Dim intSamm1 As Integer
Dim strSamm As String
Dim intN As Integer
Dim strAll As String
Dim strN As String
Dim intI As String
Dim intRepeat As Integer
Dim intRep As Integer
Dim bln1Prv As Boolean
Dim intFF As Integer
Dim intDD As Integer
Dim blnFA As Boolean
 
Do
intI = 0
strAll = "" ' î÷èñòêà ïåðåìåííîé
intRep = 0 ' î÷èñòêà ïåðåìåííîé
bln1Prv = False
strN = InputBox("Ââåäèòå ðàçìåð ìàññèâà", "Ââîä ðàçìåðà ìàññèâà") ' âîäèì ðàçìåð ìàññèâà
If StrPtr(strN) = 0 Then Exit Sub
    bln1Prv = IsNumeric(strN) ' ïðîâåðÿåò ÿâëÿåòñÿ ëè ïåðåìåííàÿ ÷èñëîì
If bln1Prv = False Then
    MsgBox ("Íåîáõîäèìî ââîäèòü ÷èñëî")
Exit Sub ' âûõîä
Else: intN = CInt(strN)
End If
If CStr(strN) = 0 Then
    MsgBox ("ðàçìåð ìàññèâà íå ìîæåò áûòü ðàâåí 0")
    Exit Sub
End If
If strN = "" Then
    MsgBox ("Ïóñòîå ïîëå")
    Exit Sub
End If
ReDim intMas(intN) 'Èçìåíåíèå ðàçìåðà ìàññèâà
For intSamm = 1 To intN Step 1
    strSamm = InputBox("Ââåäèòå ýëåìåíòû ìàññèâà", "Ââîä ýëåìåíòîâ ìàññèâà") ' ââîäèì ýë. ìàññ.
        bln1Prv = IsNumeric(strSamm) 'ïðîâåðêà ÷èñëà
    If bln1Prv = False Then
        MsgBox ("Íåîáõîäèìî ââîäèòü ÷èñëî")
        Exit Sub ' âûõîä èç ïðîãðàììû
    Else: intMas(intSamm) = CInt(strSamm)
    End If ' êîíåö âûáîðà
Next intSamm ' ñääåæþùåå çíà÷åíèå ïåðåìåííîé
    intCesl = InputBox("Ââåäèòå ÷èñëî", "Ââîä ÷èñëà K") ' Ââîä ÷èñëà
For intSamm = intN To 1 Step (-1)
If (intMas(intSamm) Mod intCesl = 0) Then  ' åñëè ÷èñëà ìàññèâà äåëÿòñÿ áåç îñòàòêà íà ÷èñëî Ê è íå ðîâíî 0 òîãäà
'ReDim Preserve intMas(UBound(intMas) + 1)
End If ' êîíåö âûáîðà
Next intSamm ' ñääåæþùåå çíà÷åíèå ïåðåìåííîé
 
For intSamm = UBound(intMas) To 1 Step (-1)
'If (intSamm <> UBound(intMas)) Then
If (intMas(intSamm) Mod intCesl = 0) Then
ReDim Preserve intMas(UBound(intMas) + 1)
'For intSamm1 = UBound(intMas) To intSamm Step (-1)
'Cells(intSamm, intCesl).Value = intMas(intSamm)
'intMas(intSamm + 1) = intMas(intSamm)
'Next intSamm1
End If
'intMas(intSamm + 1) = intMas(intSamm)
'Else:   intMas(intSamm + 1) = intMas(intSamm)
'End If
'If (intMas(intSamm) Mod intCesl = 0) Then
'intMas(intSamm + 1) = intCesl
'End If
'End If
Next intSamm
 
 
 
For intSamm = 1 To UBound(intMas)
strAll = strAll & intMas(intSamm) & Space(1)
Next intSamm
 
MsgBox ("Ìàññèâ : " + strAll)
intRepeat = MsgBox("Ïîâòîðèòü?", vbYesNo, "Âîïðîñ") ' çàïðîñ î ïîâòîðå
If intRepeat = vbYes Then intRep = 1
If intRepeat = vbNo Then intRep = 0
Loop While intRep = 1 ' åñëè 1 òîãäà ïîâòîð öèêëà
If intRep = 0 Then Exit Sub ' âûõîä
End Sub ' Êîíåö

Sub Mas_rasm()
 
 
Dim rasm%, ind%, krat%, shag%, r%
Dim mas(10000) ' чтобы не вводить в цикл redim задала сразу размер 10000
 
 
krat = Val(InputBox("введите кратное"))
1:
rasm = Val(InputBox("задайте размер массива")) 'задаем размер массива
 
 
If Round(rasm) <= 0 Then 'проверяем, равен ли  размер массива положительному числу 
y = MsgBox("Размер массива должен быть положительным числом", vbOKOnly) GoTo 1
End If
 
' запускаем цикл ввода элементов и обработки
 
While ind < rasm 
mas(ind) = Val(InputBox("введите " & ind & "-й элемент массива"))  'вводим элементы
shag = IIf(mas(ind) Mod krat = 0, 2, 1) 'задаем шаг(если деление на требуемое кратное без остатка, тогда увеличиваем размер массива на 1 и индекс на 2)
rasm = rasm + shag - 1
mas(ind + 1) = krat 'при делении без остатка следующим элементом после введенного числа станет требуемое кратное
ind = ind + shag
Wend
 
'проверим выводом в excel
For r = 1 To rasm
Cells(r, 1).Value = mas(r - 1)
Next
 
End Sub