Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Добавление новой строки по условию
 
#1
24.11.2020 15:28:52
Доброго всем времени суток! Суть вопроса в следующем: как можно автоматически организовать добавление строки с данными той строки у которой в последнем столбце стоит знак дроби, а потом значение которое написано через дробь занести в последнюю ячейку по одному числу. Надеюсь максимально понятно высказался, если нет, буду рад ответить на вопросы. Заранее благодарен всем за ответы.
З.Ы. Как альтернатива, можно ли хотя бы копировать строку целиком, на строку ниже если в последнем столбце стоит знак дроби
 
 
 
#2
24.11.2020 16:00:46
TMD,  вариант 1
Код
Sub dsss()
Dim i As Long, lr As Long, arr, arr2, n As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row
For i = lr To 3 Step -1
    If InStr(Cells(i, 6), "/") <> 0 Then
        Rows(i).Insert
        Range(Cells(i + 1, 2), Cells(i + 1, 6)).Copy Destination:=Cells(i, 2)
        Cells(i, 6) = Left(Cells(i, 6), InStr(Cells(i, 6), "/") - 1)
        Cells(i + 1, 6) = Right(Cells(i + 1, 6), Len(Cells(i + 1, 6)) - InStr(Cells(i + 1, 6), "/"))
    End If
Next i
End Sub
в файле этот вариант 2
Код
Sub ds()
Dim i As Long, lr As Long, arr, arr2, n As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row
x = Application.WorksheetFunction.CountIf(Range(Cells(3, 6), Cells(lr, 6)), "*/*") + Application.WorksheetFunction.CountA(Range(Cells(3, 6), Cells(lr, 6)))
ReDim arr2(1 To x, 1 To 5)
k = 1
For i = 3 To lr
    arr = Split(Cells(i, 6), "/")
    For n = 0 To UBound(arr)
        arr2(k, 1) = Cells(i, 2)
        arr2(k, 2) = Cells(i, 3)
        arr2(k, 3) = Cells(i, 4)
        arr2(k, 4) = Cells(i, 5)
        arr2(k, 5) = arr(n)
        k = k + 1
    Next n
Next i
Range("H3").Resize(UBound(arr2), 5) = arr2
End Sub
Изменено: Mershik - 24.11.2020 16:16:39
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
24.11.2020 16:15:49
Mershik, Спасибо, работает!!! Немного протестирую, если будут вопросы обращусь :)
 
 
 
#4
24.11.2020 17:33:17
Цитата
Mershik написал:
в файле этот вариант 2
Очень извиняюсь, но мне нужна еще Ваша помощь, сразу я затупил и не сообразил, что после колонки с дробью бывают еще 4 колонки с текстом который нужно копировать, так как и те ячейки которые до колонки с дробью, можете подправить вариант 2 под этот случай? Сам пробовал подобрать что куда менять, ничего не получилось :(
Заранее благодарен.
Новый файл пример прикрепляю
 
 
 
#5
24.11.2020 17:51:15
TMD,
Код
Sub ds()
Dim i As Long, lr As Long, arr, arr2, n As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row
x = Application.WorksheetFunction.CountIf(Range(Cells(3, 6), Cells(lr, 6)), "*/*") + Application.WorksheetFunction.CountA(Range(Cells(3, 6), Cells(lr, 6)))
ReDim arr2(1 To x, 1 To 9)
k = 1
For i = 3 To lr
    arr = Split(Cells(i, 6), "/")
    For n = 0 To UBound(arr)
        arr2(k, 1) = Cells(i, 2)
        arr2(k, 2) = Cells(i, 3)
        arr2(k, 3) = Cells(i, 4)
        arr2(k, 4) = Cells(i, 5)
        arr2(k, 5) = arr(n)
        arr2(k, 6) = Cells(i, 7)
        arr2(k, 7) = Cells(i, 8)
        arr2(k, 8) = Cells(i, 9)
        arr2(k, 9) = Cells(i, 10)

        k = k + 1
    Next n
Next i
Range("L3").Resize(UBound(arr2), 9) = arr2
End Sub

Код
Sub dsss()
Dim i As Long, lr As Long, arr, arr2, n As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row
For i = lr To 3 Step -1
    If InStr(Cells(i, 6), "/") <> 0 Then
        Rows(i).Insert
        Range(Cells(i + 1, 2), Cells(i + 1, 10)).Copy Destination:=Cells(i, 2)
        Cells(i, 6) = Left(Cells(i, 6), InStr(Cells(i, 6), "/") - 1)
        Cells(i + 1, 6) = Right(Cells(i + 1, 6), Len(Cells(i + 1, 6)) - InStr(Cells(i + 1, 6), "/"))
    End If
Next i
End Sub
Изменено: Mershik - 24.11.2020 17:55:23
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#6
24.11.2020 18:10:06
Mershik, Спасибо, Вы мне очень помогли :)
 
 
 
Страницы: 1
Наверх