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

Вход

Регистрация

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

 

= Мир MS Excel/Добавление заданного количества строк и их заполнение - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Добавление заданного количества строк и их заполнение (Формулы/Formulas)
Добавление заданного количества строк и их заполнение
Alhim51 Дата: Четверг, 04.02.2016, 12:11 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день!
Есть файл (лист 2: перечень многоквартирных домов и их технические характеристики), в каждой строке есть количество квартир в данных многоквартирных домах (выделено красным).
Задача:
1. необходимо добавить на лист 1 строку из листа 2;
2. после каждой добавленной строки с адресом МКД добавить количество строк, равное количеству квартир в каждом доме;
3. заполнить пустые строки информацией.
Учитывая количество домов (почти 1500), пожалуйста помогите автоматизировать процесс, ибо %)
[moder]Размер файла 0
К сообщению приложен файл: 1980648.xlsx(0Kb)


Сообщение отредактировал _Boroda_ - Четверг, 04.02.2016, 12:13
 
Ответить
СообщениеДобрый день!
Есть файл (лист 2: перечень многоквартирных домов и их технические характеристики), в каждой строке есть количество квартир в данных многоквартирных домах (выделено красным).
Задача:
1. необходимо добавить на лист 1 строку из листа 2;
2. после каждой добавленной строки с адресом МКД добавить количество строк, равное количеству квартир в каждом доме;
3. заполнить пустые строки информацией.
Учитывая количество домов (почти 1500), пожалуйста помогите автоматизировать процесс, ибо %)
[moder]Размер файла 0

Автор - Alhim51
Дата добавления - 04.02.2016 в 12:11
китин Дата: Четверг, 04.02.2016, 12:13 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3443
Репутация: 546 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
файл битый.не открыается


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
Сообщениефайл битый.не открыается

Автор - китин
Дата добавления - 04.02.2016 в 12:13
Alhim51 Дата: Четверг, 04.02.2016, 12:16 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Извините, пересохранила в другом формате
К сообщению приложен файл: 1628827.xls(55Kb)
 
Ответить
СообщениеИзвините, пересохранила в другом формате

Автор - Alhim51
Дата добавления - 04.02.2016 в 12:16
Manyasha Дата: Четверг, 04.02.2016, 13:13 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1587
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
Alhim51, так подойдет?
[vba]
Код
Sub разбить_по_квартирам()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Dim i&, j&, lr&, r&, k&, rr&
    Dim shData As Worksheet, shRes As Worksheet, rng
    Set shData = ThisWorkbook.Sheets("Лист2")
    Set shRes = ThisWorkbook.Sheets("Лист1")
    shRes.[a4].Resize(shRes.Rows.Count - 3, 28).ClearContents
    With shData
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        rng = .Range("a4:ab" & lr).Value
        Dim curR&, curC&
        curR = ActiveCell.Row: curC = ActiveCell.Column
        rr = Rows.Count
        Dim rngRes()
        r = 0
        For i = 1 To lr - 3
            For j = 1 To rng(i, 12)
                ReDim Preserve rngRes(0 To 27, 0 To r)
                For k = 1 To 28
                    rngRes(k - 1, r) = rng(i, k)
                Next k
                rngRes(11, r) = j
                r = r + 1
            Next j
        Next i
        With shRes
            .[a4].Resize(r, 28).Value = Application.Transpose(rngRes)
            shData.Range("a4:ab4").Copy
            .Range("a4:ab" & r + 3).PasteSpecial Paste:=xlPasteFormats
        End With
    End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 1628827-1.xls(50Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеAlhim51, так подойдет?
[vba]
Код
Sub разбить_по_квартирам()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Dim i&, j&, lr&, r&, k&, rr&
    Dim shData As Worksheet, shRes As Worksheet, rng
    Set shData = ThisWorkbook.Sheets("Лист2")
    Set shRes = ThisWorkbook.Sheets("Лист1")
    shRes.[a4].Resize(shRes.Rows.Count - 3, 28).ClearContents
    With shData
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        rng = .Range("a4:ab" & lr).Value
        Dim curR&, curC&
        curR = ActiveCell.Row: curC = ActiveCell.Column
        rr = Rows.Count
        Dim rngRes()
        r = 0
        For i = 1 To lr - 3
            For j = 1 To rng(i, 12)
                ReDim Preserve rngRes(0 To 27, 0 To r)
                For k = 1 To 28
                    rngRes(k - 1, r) = rng(i, k)
                Next k
                rngRes(11, r) = j
                r = r + 1
            Next j
        Next i
        With shRes
            .[a4].Resize(r, 28).Value = Application.Transpose(rngRes)
            shData.Range("a4:ab4").Copy
            .Range("a4:ab" & r + 3).PasteSpecial Paste:=xlPasteFormats
        End With
    End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 04.02.2016 в 13:13
Alhim51 Дата: Четверг, 04.02.2016, 13:17 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
:'( и куда это вписать надо?
 
Ответить
Сообщение:'( и куда это вписать надо?

Автор - Alhim51
Дата добавления - 04.02.2016 в 13:17
Alhim51 Дата: Четверг, 04.02.2016, 13:23 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Manyasha, Вы, наверное, перед отправкой забыли сохранить((
 
Ответить
СообщениеManyasha, Вы, наверное, перед отправкой забыли сохранить((

Автор - Alhim51
Дата добавления - 04.02.2016 в 13:23
Alhim51 Дата: Четверг, 04.02.2016, 13:43 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Извините!! Со всем разобралась!! Все работает!!! Спасибо большое)))) :D
 
Ответить
СообщениеИзвините!! Со всем разобралась!! Все работает!!! Спасибо большое)))) :D

Автор - Alhim51
Дата добавления - 04.02.2016 в 13:43
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Добавление заданного количества строк и их заполнение (Формулы/Formulas)
Страница 1 из 11
Поиск:

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