Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Вставка строк в зависимости от условия - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Вставка строк в зависимости от условия
AnRusik Дата: Вторник, 05.09.2023, 11:17 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 1 ±
Замечаний: 20% ±

2010
Здравствуйте.
Подскажите пожалуйста можно ли макросом сделать вставку строк в зависимости от условия.
Сделал пример: допустим есть база изделий (см. лист База) со своими кодами на каждое изделие и со своими свойствами (см. лист Свойства). Свойства могут меняться. Соответственно нужно сделать единую таблицу (см. лист ИТОГ), что бы было обозначение самого изделия и через пробел "Код:" изделия, а ниже, в зависимости от свойств изделия добавлялись строки.
Спасибо.
К сообщению приложен файл: kniga1.xlsx (12.2 Kb)
 
Ответить
СообщениеЗдравствуйте.
Подскажите пожалуйста можно ли макросом сделать вставку строк в зависимости от условия.
Сделал пример: допустим есть база изделий (см. лист База) со своими кодами на каждое изделие и со своими свойствами (см. лист Свойства). Свойства могут меняться. Соответственно нужно сделать единую таблицу (см. лист ИТОГ), что бы было обозначение самого изделия и через пробел "Код:" изделия, а ниже, в зависимости от свойств изделия добавлялись строки.
Спасибо.

Автор - AnRusik
Дата добавления - 05.09.2023 в 11:17
Nic70y Дата: Вторник, 05.09.2023, 11:46 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 9005
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
как-то так, наверное
[vba]
Код
Sub u_611()
    Application.ScreenUpdating = False
    a = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row
    Sheets("ИТОГ").Range("a1:f" & a).Clear
    b = Sheets("База").Cells(Rows.Count, "a").End(xlUp).Row
    For c = 2 To b
        d = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row + 1
        e = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Value
        If e = "" Then d = 1
        f = Sheets("База").Range("a" & c).Value
        g = Sheets("База").Range("b" & c).Value
        h = f & " Код:" & g
        Sheets("ИТОГ").Range("a" & d & ":f" & d).Merge
        Sheets("ИТОГ").Range("a" & d & ":f" & d).HorizontalAlignment = xlCenter
        Sheets("ИТОГ").Range("a" & d & ":f" & d).Borders.LineStyle = True
        Sheets("ИТОГ").Range("a" & d) = h
        i = Sheets("База").Range("c" & c).Value
        j = Application.Match(i, Sheets("Свойства").Range("a:a"), 0)
        If IsNumeric(j) Then
            k = Application.CountIf(Sheets("Свойства").Range("a:a"), i)
            l = k + j - 1
            Sheets("Свойства").Range("b" & j & ":g" & l).Copy Sheets("ИТОГ").Range("a" & d + 1)
        End If
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 1237599.xlsm (27.8 Kb)


ЮMoney 41001841029809
 
Ответить
Сообщениекак-то так, наверное
[vba]
Код
Sub u_611()
    Application.ScreenUpdating = False
    a = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row
    Sheets("ИТОГ").Range("a1:f" & a).Clear
    b = Sheets("База").Cells(Rows.Count, "a").End(xlUp).Row
    For c = 2 To b
        d = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row + 1
        e = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Value
        If e = "" Then d = 1
        f = Sheets("База").Range("a" & c).Value
        g = Sheets("База").Range("b" & c).Value
        h = f & " Код:" & g
        Sheets("ИТОГ").Range("a" & d & ":f" & d).Merge
        Sheets("ИТОГ").Range("a" & d & ":f" & d).HorizontalAlignment = xlCenter
        Sheets("ИТОГ").Range("a" & d & ":f" & d).Borders.LineStyle = True
        Sheets("ИТОГ").Range("a" & d) = h
        i = Sheets("База").Range("c" & c).Value
        j = Application.Match(i, Sheets("Свойства").Range("a:a"), 0)
        If IsNumeric(j) Then
            k = Application.CountIf(Sheets("Свойства").Range("a:a"), i)
            l = k + j - 1
            Sheets("Свойства").Range("b" & j & ":g" & l).Copy Sheets("ИТОГ").Range("a" & d + 1)
        End If
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 05.09.2023 в 11:46
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!