Добрый день, Уважаемые Участники Форума прошу подсказать решение Имеется файл со строками в столбце F указаны размеры с 6-24 кратные 2 При выборе дипазона с размерами Нужно создать для каждого размера свою строку с копированием/дублированием данных по строке для каждого размера Моя проблема заключатся в том, что не понимаю как добавить каждую строку на новый лист. код прилагаю: [vba]
Код
Public Sub Size() Dim A() As String, B() As String Dim i As Long, j As Long Dim Cell As Range Dim stroka Dim stolbets For Each Cell In Selection
Вроде через отладку выводит все размеры, но как только пытаюсь в новый лист копировать, то всегда последнее значение остается только) Файл прилагаю. Прошу помочь как перенести размеры на новый лист?
Добрый день, Уважаемые Участники Форума прошу подсказать решение Имеется файл со строками в столбце F указаны размеры с 6-24 кратные 2 При выборе дипазона с размерами Нужно создать для каждого размера свою строку с копированием/дублированием данных по строке для каждого размера Моя проблема заключатся в том, что не понимаю как добавить каждую строку на новый лист. код прилагаю: [vba]
Код
Public Sub Size() Dim A() As String, B() As String Dim i As Long, j As Long Dim Cell As Range Dim stroka Dim stolbets For Each Cell In Selection
Вроде через отладку выводит все размеры, но как только пытаюсь в новый лист копировать, то всегда последнее значение остается только) Файл прилагаю. Прошу помочь как перенести размеры на новый лист?Zaga83
Public Sub SizeRazm() Dim d_ As Range Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual On Error Resume Next r_ = Selection(1).Row c_ = Selection(1).Column With Sheets("Лист2") For Each d_ In Selection If d_ <> "" Then ar0 = d_.Offset(, -5).Resize(, 5) ar = Split(d_, "-") For i = ar(0) To ar(1) Step 2 .Cells(r_ + n_, c_).Offset(, -5).Resize(, 5) = ar0 .Cells(r_ + n_, c_) = i n_ = n_ + 1 Next i End If Next d_ End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
[/vba]
Проверки всякие не стал писать [vba]
Код
Public Sub SizeRazm() Dim d_ As Range Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual On Error Resume Next r_ = Selection(1).Row c_ = Selection(1).Column With Sheets("Лист2") For Each d_ In Selection If d_ <> "" Then ar0 = d_.Offset(, -5).Resize(, 5) ar = Split(d_, "-") For i = ar(0) To ar(1) Step 2 .Cells(r_ + n_, c_).Offset(, -5).Resize(, 5) = ar0 .Cells(r_ + n_, c_) = i n_ = n_ + 1 Next i End If Next d_ End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
Добрый день. подкорректировал Ваш код, закомментил лишнее, не подметал за собой, поэтому под спойлер
[vba]
Код
Public Sub Size() Dim A() As String 'B() As String Dim i As Long 'j As Long Dim Cell As Range Dim copy_row As Range 'Dim stroka 'Dim stolbets Dim lRow 'Dim lLastrowInSelectedRange 'Dim MyArray() For Each Cell In Selection 'Dim s As Integer 'Dim y As Long 'lRow = Selection.Row 'первая строка 'lLastrowInSelectedRange = Selection.Row + Selection.Rows.Count - 1 'последняя строка Dim arr_() ReDim arr_(0) 'stroka = Cell.Row 'stolbets = Cell.Column A = Split(Cell.Value, "-") 'B = Split(Cells(stroka, stolbets), "-") ' MsgBox A(0) ' MsgBox B(1) Set copy_row = Cell.Offset(0, -5).Resize(1, 5) For i = CLng(A(0)) To CLng(A(1)) Step 2 arr_(UBound(arr_)) = i 'Debug.Print i ReDim Preserve arr_(UBound(arr_) + 1) Next i With Sheets(2) lRow = .Cells(Rows.Count, 6).End(xlUp).Row + 1 .Cells(lRow, 6).Resize(UBound(arr_)) = Application.Transpose(arr_) .Cells(lRow, 1).Resize(UBound(arr_), 5).Value = copy_row.Value End With Next Cell End Sub
[/vba]
Добрый день. подкорректировал Ваш код, закомментил лишнее, не подметал за собой, поэтому под спойлер
[vba]
Код
Public Sub Size() Dim A() As String 'B() As String Dim i As Long 'j As Long Dim Cell As Range Dim copy_row As Range 'Dim stroka 'Dim stolbets Dim lRow 'Dim lLastrowInSelectedRange 'Dim MyArray() For Each Cell In Selection 'Dim s As Integer 'Dim y As Long 'lRow = Selection.Row 'первая строка 'lLastrowInSelectedRange = Selection.Row + Selection.Rows.Count - 1 'последняя строка Dim arr_() ReDim arr_(0) 'stroka = Cell.Row 'stolbets = Cell.Column A = Split(Cell.Value, "-") 'B = Split(Cells(stroka, stolbets), "-") ' MsgBox A(0) ' MsgBox B(1) Set copy_row = Cell.Offset(0, -5).Resize(1, 5) For i = CLng(A(0)) To CLng(A(1)) Step 2 arr_(UBound(arr_)) = i 'Debug.Print i ReDim Preserve arr_(UBound(arr_) + 1) Next i With Sheets(2) lRow = .Cells(Rows.Count, 6).End(xlUp).Row + 1 .Cells(lRow, 6).Resize(UBound(arr_)) = Application.Transpose(arr_) .Cells(lRow, 1).Resize(UBound(arr_), 5).Value = copy_row.Value End With Next Cell End Sub
Добрый день! _Boroda_, и sboy, Ваш код просто супер и мне конечно хочеться задать по некоторым строкам кода вопросы
Вопрос для _Boroda_, [vba]
Код
For i = Ar(0) To Ar(1) Step 2 .Cells(r_ + n_, c_).Offset(, -5).Resize(, 5) = ar0 .Cells(r_ + n_, c_) = i n_ = n_ + 1 Next i
[/vba] Получается чтобы перенести все значения с каждым размером в новую последующюю ячейку нам нужно в цикл вставить счетчик n_=n_+1? чтобы была возможность переносить значение в новую строку с учетом значения r_? Я правильно понимаю?
Вопрос для sboy, [vba]
Код
For i = CLng(A(0)) To CLng(A(1)) Step 2 arr_(UBound(arr_)) = i ReDim Preserve arr_(UBound(arr_) + 1) Next i
[/vba] Получается значение i мы заносим в массив arr_ c верхней границей и для чего добавляем +1?
такой код пока выше моего понимания, чтобы самостоятельно такие конструкции создавать...
Прошу ответить на мои вопросы
Добрый день! _Boroda_, и sboy, Ваш код просто супер и мне конечно хочеться задать по некоторым строкам кода вопросы
Вопрос для _Boroda_, [vba]
Код
For i = Ar(0) To Ar(1) Step 2 .Cells(r_ + n_, c_).Offset(, -5).Resize(, 5) = ar0 .Cells(r_ + n_, c_) = i n_ = n_ + 1 Next i
[/vba] Получается чтобы перенести все значения с каждым размером в новую последующюю ячейку нам нужно в цикл вставить счетчик n_=n_+1? чтобы была возможность переносить значение в новую строку с учетом значения r_? Я правильно понимаю?
Вопрос для sboy, [vba]
Код
For i = CLng(A(0)) To CLng(A(1)) Step 2 arr_(UBound(arr_)) = i ReDim Preserve arr_(UBound(arr_) + 1) Next i
[/vba] Получается значение i мы заносим в массив arr_ c верхней границей и для чего добавляем +1?
такой код пока выше моего понимания, чтобы самостоятельно такие конструкции создавать...
arr_(UBound(arr_)) = i ' присваиваем последнему элементу массива значение i ReDim Preserve arr_(UBound(arr_) + 1) 'увеличиваем размер массива на 1 с сохранением предыдущих элементов
[/vba]
[vba]
Код
arr_(UBound(arr_)) = i ' присваиваем последнему элементу массива значение i ReDim Preserve arr_(UBound(arr_) + 1) 'увеличиваем размер массива на 1 с сохранением предыдущих элементов
нам нужно в цикл вставить счетчик n_=n_+1? чтобы была возможность переносить значение в новую строку с учетом значения r_? Я правильно понимаю?
Абсолютно. Мы определяем первую строку r_ и дальше для любого количества значений типа "6-24" просто тупо прибавляем к r_ по единичке на каждую пару (6-8-10-12-...)
нам нужно в цикл вставить счетчик n_=n_+1? чтобы была возможность переносить значение в новую строку с учетом значения r_? Я правильно понимаю?
Абсолютно. Мы определяем первую строку r_ и дальше для любого количества значений типа "6-24" просто тупо прибавляем к r_ по единичке на каждую пару (6-8-10-12-...)_Boroda_