Здравствуйте, уважаемые форумчане! Я искал по ключевым словам по своей проблеме, но не нашел похожего решения(или может не так названо оно). Может кто знает, как решить эту задачу?? Нужно автоматизировать процесс вырезания ячеек и копирования с добавлением ячеек, взависимости от кол-ва других ячеек. Наглядность задачи в файле.
Здравствуйте, уважаемые форумчане! Я искал по ключевым словам по своей проблеме, но не нашел похожего решения(или может не так названо оно). Может кто знает, как решить эту задачу?? Нужно автоматизировать процесс вырезания ячеек и копирования с добавлением ячеек, взависимости от кол-ва других ячеек. Наглядность задачи в файле.yurikfirst
Option Base 1 Sub dobav() Dim result1() Dim result2() ReDim result1(1) ReDim result2(1) For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row arr = Range(Cells(r, 1), Cells(r, Columns.Count).End(xlToLeft)).Value For i = 2 To UBound(Application.Transpose(arr)) n = n + 1 result1(n) = Cells(r, 1).Value result2(n) = arr(1, i) ReDim Preserve result1(UBound(result1) + 1) ReDim Preserve result2(UBound(result2) + 1) Next i Next Cells(r + 3, 1).Resize(UBound(result1), 1) = Application.Transpose(result1) Cells(r + 3, 2).Resize(UBound(result2), 1) = Application.Transpose(result2) End Sub
[/vba]
Добрый день [vba]
Код
Option Base 1 Sub dobav() Dim result1() Dim result2() ReDim result1(1) ReDim result2(1) For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row arr = Range(Cells(r, 1), Cells(r, Columns.Count).End(xlToLeft)).Value For i = 2 To UBound(Application.Transpose(arr)) n = n + 1 result1(n) = Cells(r, 1).Value result2(n) = arr(1, i) ReDim Preserve result1(UBound(result1) + 1) ReDim Preserve result2(UBound(result2) + 1) Next i Next Cells(r + 3, 1).Resize(UBound(result1), 1) = Application.Transpose(result1) Cells(r + 3, 2).Resize(UBound(result2), 1) = Application.Transpose(result2) End Sub