Здраствуйте уважаемые форумчане! Снова обращаюсь за помощью.
ДАНО: Таблица с значениями структурированными по 2-ва столбца. Рисунок1.
ЗАДАЧА:1)Добавить после каждых 2-х столбцов новые столбцы с записями единички -1. Выполнить макросом т.к. реальная таблица большая на сотни столбцов и тисячи рядов и таких таблиц много.
2) Повторить тоже самое только с вставкой одного столбца с единичками через каждых два.
Буду ОЧЕНЬ благодарен за помощь знающим людям. Файл примера прикрепляю.
Public Sub AppendTwoColumnsAtLeft()
Dim vData As Variant, vOut() As Variant
Dim i As Long, k As Long, id As Long
vData = ActiveCell.CurrentRegion.Value
ReDim vOut(1 To UBound(vData, 1), 1 To Application.RoundUp(UBound(vData, 2) / 2, 0) * 4)
For i = 1 To UBound(vData, 1)
For k = 1 To UBound(vData, 2) Step 2
id = 2 * (k - 1)
vOut(i, id + 1) = vData(i, k)
vOut(i, id + 2) = vData(i, k + 1)
vOut(i, id + 3) = 1
vOut(i, id + 4) = 1
Next
Next
ActiveCell.CurrentRegion.Cells(1, 1).Resize(UBound(vOut, 1), UBound(vOut, 2)).Value = vOut
End Sub
Зачем повторять уже сделанное, но застенчиво не приложенное?
Добавить после каждых 2-х столбцов новые столбцы с записями единички -1.
Код
Sub InsertColumns()
Dim i As Long
Dim iLastRow As Long
Dim iLastCol As Integer
iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastCol - 1 To 3 Step -2
Columns(i).Resize(, 2).Insert
Range(Cells(1, i), Cells(iLastRow, i + 1)) = 1
Next
End Sub
Sub Ins2Columns()
Dim c&
For c = Cells(1, Columns.Count).End(xlToLeft).Column - 1 To 3 Step -2
Columns(c).Resize(, 2).Insert shift:=xlShiftToRight
Next
End Sub