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

Вход

Регистрация

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

 

= Мир MS Excel/Сбор данных с листов с разной структурой - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Сбор данных с листов с разной структурой (Формулы/Formulas)
Сбор данных с листов с разной структурой
stas8892 Дата: Среда, 06.03.2024, 10:10 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 20% ±

Microsoft Office Standart 2019
Господа форумчане! Помогите пожалуйста решить 3 задачи.
В документе необходимо:
а. Из листа 1 по порядку слева на право выводить в плоскую таблицу на лист 4 "животных" и "номера" по порядку с верху вниз
б. Из листа 2 подтягивать "характеристику" на лист 4 в соответствии с "номером"
в. Из листа 2 делить "количество" на "количество" с листа 3 и выводить на лист 4 в соответствии с "животным"
К сообщению приложен файл: 219_1_1.xlsm (20.1 Kb)
 
Ответить
СообщениеГоспода форумчане! Помогите пожалуйста решить 3 задачи.
В документе необходимо:
а. Из листа 1 по порядку слева на право выводить в плоскую таблицу на лист 4 "животных" и "номера" по порядку с верху вниз
б. Из листа 2 подтягивать "характеристику" на лист 4 в соответствии с "номером"
в. Из листа 2 делить "количество" на "количество" с листа 3 и выводить на лист 4 в соответствии с "животным"

Автор - stas8892
Дата добавления - 06.03.2024 в 10:10
Nic70y Дата: Среда, 06.03.2024, 10:11 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 8759
Репутация: 2273 ±
Замечаний: 0% ±

Excel 2010
стандартный модуль
[vba]
Код
Sub u_6()
    'отключаем обновление экрана
    Application.ScreenUpdating = False
    'сотрем старые данные.....................................
    'нижняя, заполненная ячейка столбца A листа 4
    a = Sheets("4").Cells(Rows.Count, "a").End(xlUp).Row
    If a > 1 Then Sheets("4").Range("a2:d" & a).Clear
    'запишем новые данные.....................................
    'нижняя, заполненная ячейка столбца A листа 1
    b = Sheets("1").Cells(Rows.Count, "a").End(xlUp).Row
    If b > 1 Then
        'пройдемся циклом по строка листа 1
        For c = 2 To b 'со 2-й по нижнюю
            'правый столбец проверяемой строки
            d = Sheets("1").Cells(c, Columns.Count).End(xlToLeft).Column
            If d > 1 Then
                e = d - 1 'кол-во номеров в строке
                f = Sheets("4").Cells(Rows.Count, "a").End(xlUp).Row + 1 'очередная строка вставки
                g = f + e - 1
                h = Sheets("1").Range("a" & c).Value 'животное Лист 1
                Sheets("4").Range("a" & f & ":a" & g) = h 'запишем животное на лист 4
                'запищем номера
                Sheets("1").Range(Sheets("1").Cells(c, 2), Sheets("1").Cells(c, d)).Copy
                Sheets("4").Range("b" & f).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=True
                'очистим буфер обмена
                Application.CutCopyMode = False
                'характеристи
                i = Application.Match(h, Sheets("2").Range("c:c"), 0) 'верхняя строка животного
                j = Application.CountIf(Sheets("2").Range("c:c"), h)
                k = i + j - 1 'нижняя строка животного
                'пройдемся по номерам, найдем характеристики
                For Each l In Sheets("4").Range("b" & f & ":b" & g)
                    m = l.Value 'номер
                    'Application.VLookup = формула* ВПР
                    'характеристики
                    l.Offset(0, 1) = Application.VLookup(m, Sheets("2").Range("a" & i & ":b" & k), 2, 0)
                    'кол-во лист 2
                    n = Application.VLookup(m, Sheets("2").Range("a" & i & ":d" & k), 4, 0)
                    'кол-во лист 3
                    o = Application.VLookup(h, Sheets("3").Range("a:b"), 2, 0)
                    l.Offset(0, 2) = n / o
                Next
            End If
        Next
    End If
    'включаем обновление экрана
    Application.ScreenUpdating = True
End Sub
[/vba]

апдэйт
файл перезалил, "сломался" другой макрос из-за изменения таблицы, исправил


апдэйт
добавил формульный вариант
К сообщению приложен файл: 2111_1.xlsx (16.9 Kb) · 2111.xlsm (29.8 Kb)


ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Среда, 06.03.2024, 11:33
 
Ответить
Сообщениестандартный модуль
[vba]
Код
Sub u_6()
    'отключаем обновление экрана
    Application.ScreenUpdating = False
    'сотрем старые данные.....................................
    'нижняя, заполненная ячейка столбца A листа 4
    a = Sheets("4").Cells(Rows.Count, "a").End(xlUp).Row
    If a > 1 Then Sheets("4").Range("a2:d" & a).Clear
    'запишем новые данные.....................................
    'нижняя, заполненная ячейка столбца A листа 1
    b = Sheets("1").Cells(Rows.Count, "a").End(xlUp).Row
    If b > 1 Then
        'пройдемся циклом по строка листа 1
        For c = 2 To b 'со 2-й по нижнюю
            'правый столбец проверяемой строки
            d = Sheets("1").Cells(c, Columns.Count).End(xlToLeft).Column
            If d > 1 Then
                e = d - 1 'кол-во номеров в строке
                f = Sheets("4").Cells(Rows.Count, "a").End(xlUp).Row + 1 'очередная строка вставки
                g = f + e - 1
                h = Sheets("1").Range("a" & c).Value 'животное Лист 1
                Sheets("4").Range("a" & f & ":a" & g) = h 'запишем животное на лист 4
                'запищем номера
                Sheets("1").Range(Sheets("1").Cells(c, 2), Sheets("1").Cells(c, d)).Copy
                Sheets("4").Range("b" & f).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=True
                'очистим буфер обмена
                Application.CutCopyMode = False
                'характеристи
                i = Application.Match(h, Sheets("2").Range("c:c"), 0) 'верхняя строка животного
                j = Application.CountIf(Sheets("2").Range("c:c"), h)
                k = i + j - 1 'нижняя строка животного
                'пройдемся по номерам, найдем характеристики
                For Each l In Sheets("4").Range("b" & f & ":b" & g)
                    m = l.Value 'номер
                    'Application.VLookup = формула* ВПР
                    'характеристики
                    l.Offset(0, 1) = Application.VLookup(m, Sheets("2").Range("a" & i & ":b" & k), 2, 0)
                    'кол-во лист 2
                    n = Application.VLookup(m, Sheets("2").Range("a" & i & ":d" & k), 4, 0)
                    'кол-во лист 3
                    o = Application.VLookup(h, Sheets("3").Range("a:b"), 2, 0)
                    l.Offset(0, 2) = n / o
                Next
            End If
        Next
    End If
    'включаем обновление экрана
    Application.ScreenUpdating = True
End Sub
[/vba]

апдэйт
файл перезалил, "сломался" другой макрос из-за изменения таблицы, исправил


апдэйт
добавил формульный вариант

Автор - Nic70y
Дата добавления - 06.03.2024 в 10:11
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Сбор данных с листов с разной структурой (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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