Здравствуйте уважаемые помогающие! В ячейках одного столбца вразброс указаны буквы "Р" и буквы через запятую "Р, ПР". Мне нужно редактировать лишь те строки, в ячейках которых буквы через запятую "Р, ПР", - как разделить такую строку на две ("Р" и "ПР") так, что бы все данные скопировались в новую с тем же порядковым №. Количество строк и столбцов очень большое. Пример прилагаю.
Здравствуйте уважаемые помогающие! В ячейках одного столбца вразброс указаны буквы "Р" и буквы через запятую "Р, ПР". Мне нужно редактировать лишь те строки, в ячейках которых буквы через запятую "Р, ПР", - как разделить такую строку на две ("Р" и "ПР") так, что бы все данные скопировались в новую с тем же порядковым №. Количество строк и столбцов очень большое. Пример прилагаю.Aimod
Решение макросом. Макрос обрабатывает активный лист. Выкладываю лист в том виде, для которого написан макрос. Самого макроса в файле нет.
[vba]
Код
Sub Разделить_на_строки()
Dim arrSrc(), arrRes() Dim var, lr As Long, lc As Long, lrRes As Long Dim i As Long, ii As Long, j As Long
Application.ScreenUpdating = False lr = Cells(Rows.Count, "A").End(xlUp).Row lc = Cells(1, Columns.Count).End(xlToLeft).Column arrSrc() = Range("A1").Resize(lr, lc).Value ReDim arrRes(1 To lr * 2, 1 To lc) For i = 2 To UBound(arrSrc, 1) var = Split(arrSrc(i, 4), ", ") For ii = 0 To UBound(var) lrRes = lrRes + 1 For j = 1 To UBound(arrSrc, 2) arrRes(lrRes, j) = arrSrc(i, j) Next j arrRes(lrRes, 4) = var(ii) Next ii Next i Range("A2").Resize(lrRes, UBound(arrRes, 2)).Value = arrRes() Application.ScreenUpdating = True MsgBox "Готово!", vbInformation
End Sub
[/vba]
Решение макросом. Макрос обрабатывает активный лист. Выкладываю лист в том виде, для которого написан макрос. Самого макроса в файле нет.
[vba]
Код
Sub Разделить_на_строки()
Dim arrSrc(), arrRes() Dim var, lr As Long, lc As Long, lrRes As Long Dim i As Long, ii As Long, j As Long
Application.ScreenUpdating = False lr = Cells(Rows.Count, "A").End(xlUp).Row lc = Cells(1, Columns.Count).End(xlToLeft).Column arrSrc() = Range("A1").Resize(lr, lc).Value ReDim arrRes(1 To lr * 2, 1 To lc) For i = 2 To UBound(arrSrc, 1) var = Split(arrSrc(i, 4), ", ") For ii = 0 To UBound(var) lrRes = lrRes + 1 For j = 1 To UBound(arrSrc, 2) arrRes(lrRes, j) = arrSrc(i, j) Next j arrRes(lrRes, 4) = var(ii) Next ii Next i Range("A2").Resize(lrRes, UBound(arrRes, 2)).Value = arrRes() Application.ScreenUpdating = True MsgBox "Готово!", vbInformation