Здравствуйте. Помогите пожалуйста с решением проблемы... Задача следующая: есть файл, в нем несколько столбцов. В столбце Получатель возможен вариант с разделителем "," (КС.КИП,СС,ЭТО,ВиК). Нужно если встречается такая запись, ниже вставить строку, все столбцы должны быть заполнены, как в строке где встретилась эта запись и в столбце Получатель заполнить одним из значений, например, КС.КИП. В файле выделил желтым как должно получиться. Начальную строку удалить. Спасибо.
Здравствуйте. Помогите пожалуйста с решением проблемы... Задача следующая: есть файл, в нем несколько столбцов. В столбце Получатель возможен вариант с разделителем "," (КС.КИП,СС,ЭТО,ВиК). Нужно если встречается такая запись, ниже вставить строку, все столбцы должны быть заполнены, как в строке где встретилась эта запись и в столбце Получатель заполнить одним из значений, например, КС.КИП. В файле выделил желтым как должно получиться. Начальную строку удалить. Спасибо.zaknafein
Сообщение отредактировал zaknafein - Вторник, 31.05.2016, 07:36
For i = UBound(arr) To 2 Step -1 arrCom = Split(arr(i, 1), ",") If UBound(arrCom) > 0 Then Rows(i).Copy Rows(i + 1).Resize(UBound(arrCom)).Insert For j = 0 To UBound(arrCom) Cells(i + j, "H").Value = arrCom(j) Next End If Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
[/vba]
[vba]
Код
Sub jjj()
Dim arr(), arrCom Dim lr As Long, i As Long, j As Long
For i = UBound(arr) To 2 Step -1 arrCom = Split(arr(i, 1), ",") If UBound(arrCom) > 0 Then Rows(i).Copy Rows(i + 1).Resize(UBound(arrCom)).Insert For j = 0 To UBound(arrCom) Cells(i + j, "H").Value = arrCom(j) Next End If Next
zaknafein, у Вас в примере ошибка? или я логики ещё не уловил. Почему 3 доп строки получилось, если у Вас через "запятую" было 4 выражения ('КС.КИП,СС,ЭТО,ВиК): "КС.КИП", "СС", "ЭТО", "ВиК"...
zaknafein, у Вас в примере ошибка? или я логики ещё не уловил. Почему 3 доп строки получилось, если у Вас через "запятую" было 4 выражения ('КС.КИП,СС,ЭТО,ВиК): "КС.КИП", "СС", "ЭТО", "ВиК"...Roman777
Sub obrabotka() Dim ir As Integer Dim stext As String Dim chek As Boolean
ir = Cells(Rows.Count, 1).End(xlUp).Row For q = ir To 2 Step -1 stext = Cells(q, 8).Value chek = stext Like "*,*" If chek = True Then k = 1 For x = 1 To Len(stext) If Mid(stext, x, 1) = "," Then k = k + 1 Next x n = 1 r = q For w = 1 To k p = InStr(n, stext, ",", vbTextCompare) If p = 0 Then p = Len(stext) + 1 Rows(r).Copy Rows(r).Insert (xlShiftDown)
Cells(r, 8).Value = Mid(stext, n, p - n) n = p + 1 r = r + 1 Next w Rows(r).Delete xlShiftUp End If Next q End Sub
[/vba]
[vba]
Код
Sub obrabotka() Dim ir As Integer Dim stext As String Dim chek As Boolean
ir = Cells(Rows.Count, 1).End(xlUp).Row For q = ir To 2 Step -1 stext = Cells(q, 8).Value chek = stext Like "*,*" If chek = True Then k = 1 For x = 1 To Len(stext) If Mid(stext, x, 1) = "," Then k = k + 1 Next x n = 1 r = q For w = 1 To k p = InStr(n, stext, ",", vbTextCompare) If p = 0 Then p = Len(stext) + 1 Rows(r).Copy Rows(r).Insert (xlShiftDown)
Cells(r, 8).Value = Mid(stext, n, p - n) n = p + 1 r = r + 1 Next w Rows(r).Delete xlShiftUp End If Next q End Sub
zaknafein, у Вас в примере ошибка? или я логики ещё не уловил. Почему 3 доп строки получилось, если у Вас через "запятую" было 4 выражения ('КС.КИП,СС,ЭТО,ВиК): "КС.КИП", "СС", "ЭТО", "ВиК"...
Да, ошибка.
Спасибо большое, Karataev и sboy. все работает как надо.
zaknafein, у Вас в примере ошибка? или я логики ещё не уловил. Почему 3 доп строки получилось, если у Вас через "запятую" было 4 выражения ('КС.КИП,СС,ЭТО,ВиК): "КС.КИП", "СС", "ЭТО", "ВиК"...
Да, ошибка.
Спасибо большое, Karataev и sboy. все работает как надо.zaknafein