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

Вход

Регистрация

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

 

= Мир MS Excel/Сбор данных с листов при формирование общей таблицы - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сбор данных с листов при формирование общей таблицы (Макросы/Sub)
Сбор данных с листов при формирование общей таблицы
gge29 Дата: Понедельник, 12.10.2020, 13:55 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Добрый день!!!Помогите пожалуйста с макросом.
При корректир(вручную) общей заявки формула сбивается
(лучше использовать макрос копирования с листов и вставки значений по своим колонкам)
К сообщению приложен файл: 3679615.xlsm (15.9 Kb)
 
Ответить
СообщениеДобрый день!!!Помогите пожалуйста с макросом.
При корректир(вручную) общей заявки формула сбивается
(лучше использовать макрос копирования с листов и вставки значений по своим колонкам)

Автор - gge29
Дата добавления - 12.10.2020 в 13:55
gling Дата: Понедельник, 12.10.2020, 18:59 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация: 674 ±
Замечаний: 0% ±

2010
Здравствуйте.
Посмотрите соседнею тему там уже есть макрос, приладьте его для себя.


ЯД-41001506838083
 
Ответить
СообщениеЗдравствуйте.
Посмотрите соседнею тему там уже есть макрос, приладьте его для себя.

Автор - gling
Дата добавления - 12.10.2020 в 18:59
gge29 Дата: Понедельник, 12.10.2020, 19:38 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

В макросах не силён, получится или нет, совсем не уверен
 
Ответить
СообщениеВ макросах не силён, получится или нет, совсем не уверен

Автор - gge29
Дата добавления - 12.10.2020 в 19:38
gge29 Дата: Вторник, 13.10.2020, 10:18 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Пробовал подогнать
[vba]
Код
Sub Svod()
Dim i As Long, j As Long, Rw As Long, Cl As Long
Dim a As String
Application.ScreenUpdating = False
With Sheets("Заявка")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row
Cl = .Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 3 To Rw
        For j = 2 To Cl
            a = .Cells(1, j)
            .Cells(i, j) = Application.CountIf(Sheets(a).Range("D:D"), .Cells(i, 1).Value)
        Next
    Next
End With
Application.ScreenUpdating = True
End Sub
[/vba]
не получилось (((Помогите плиз
 
Ответить
СообщениеПробовал подогнать
[vba]
Код
Sub Svod()
Dim i As Long, j As Long, Rw As Long, Cl As Long
Dim a As String
Application.ScreenUpdating = False
With Sheets("Заявка")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row
Cl = .Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 3 To Rw
        For j = 2 To Cl
            a = .Cells(1, j)
            .Cells(i, j) = Application.CountIf(Sheets(a).Range("D:D"), .Cells(i, 1).Value)
        Next
    Next
End With
Application.ScreenUpdating = True
End Sub
[/vba]
не получилось (((Помогите плиз

Автор - gge29
Дата добавления - 13.10.2020 в 10:18
gge29 Дата: Среда, 14.10.2020, 14:25 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Добрый день!Помогите допилить код,вот более или менее подходящий но чуток не то[vba]
Код
Sub CollectDataFromAllSheets()
    Dim ws As Worksheet
     
    Set wbCurrent = ActiveWorkbook
    Set wbReport = ActiveWorkbook
     
    'копируем на итоговый лист шапку табл из первого листа
    wbCurrent.Worksheets(1).Range("A3:D8").Copy Destination:=wbReport.Worksheets(1).Range("D3")
     
    'проходим в цикле по всем листам исходного файла
    For Each ws In wbCurrent.Worksheets
     
        'определяем номер последней строки на текущем и листе и листе сборки
        n = wbReport.Worksheets(1).Range("A1").CurrentRegion.Rows.Count
         
        'задаем исходный диапазон,который надо скопировать с каждого листа-любой вариант на выбор:
        Set rngData = ws.Range("A1:D5")            'фиксированный диапазон или
        Set rngData = ws.UsedRange                 'всё,что есть на листе или
        Set rngData = ws.Range("F5").CurrentRegion    'область,начиная от ячейки F5 или
        Set rngData = ws.Range("A2", ws.Range("A2").SpecialCells(xlCellTypeLastCell))    'от À2 и до конца листа
         
        'копируем исходный диапазон и вставляем в итоговую книгу со следующей строки
        rngData.Copy Destination:=wbReport.Worksheets(1).Cells(n + 1, 1)
         
    Next ws
End Sub
         
[/vba]
 
Ответить
СообщениеДобрый день!Помогите допилить код,вот более или менее подходящий но чуток не то[vba]
Код
Sub CollectDataFromAllSheets()
    Dim ws As Worksheet
     
    Set wbCurrent = ActiveWorkbook
    Set wbReport = ActiveWorkbook
     
    'копируем на итоговый лист шапку табл из первого листа
    wbCurrent.Worksheets(1).Range("A3:D8").Copy Destination:=wbReport.Worksheets(1).Range("D3")
     
    'проходим в цикле по всем листам исходного файла
    For Each ws In wbCurrent.Worksheets
     
        'определяем номер последней строки на текущем и листе и листе сборки
        n = wbReport.Worksheets(1).Range("A1").CurrentRegion.Rows.Count
         
        'задаем исходный диапазон,который надо скопировать с каждого листа-любой вариант на выбор:
        Set rngData = ws.Range("A1:D5")            'фиксированный диапазон или
        Set rngData = ws.UsedRange                 'всё,что есть на листе или
        Set rngData = ws.Range("F5").CurrentRegion    'область,начиная от ячейки F5 или
        Set rngData = ws.Range("A2", ws.Range("A2").SpecialCells(xlCellTypeLastCell))    'от À2 и до конца листа
         
        'копируем исходный диапазон и вставляем в итоговую книгу со следующей строки
        rngData.Copy Destination:=wbReport.Worksheets(1).Cells(n + 1, 1)
         
    Next ws
End Sub
         
[/vba]

Автор - gge29
Дата добавления - 14.10.2020 в 14:25
Pelena Дата: Среда, 14.10.2020, 16:41 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19163
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
gge29, мало информации.
Изначально на листе Заявка уже есть столбцы, в которые надо помещать значения? Заголовки этих столбцов всегда совпадают с именами листов? Строки на всех листах имеют одинаковый порядок?


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщениеgge29, мало информации.
Изначально на листе Заявка уже есть столбцы, в которые надо помещать значения? Заголовки этих столбцов всегда совпадают с именами листов? Строки на всех листах имеют одинаковый порядок?

Автор - Pelena
Дата добавления - 14.10.2020 в 16:41
gge29 Дата: Среда, 14.10.2020, 20:10 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Елена,добрый вечер!Заголовки этих столбцов всегда совпадают с именами листов!Строки на всех листах имеют одинаковый порядок!Весь перечень однотипный,просто всё должно собираться по имени столбца
 
Ответить
СообщениеЕлена,добрый вечер!Заголовки этих столбцов всегда совпадают с именами листов!Строки на всех листах имеют одинаковый порядок!Весь перечень однотипный,просто всё должно собираться по имени столбца

Автор - gge29
Дата добавления - 14.10.2020 в 20:10
gling Дата: Четверг, 15.10.2020, 20:21 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация: 674 ±
Замечаний: 0% ±

2010
Переделал.[vba]
Код
Sub Svod()
Dim i As Long, j As Long, Rw As Long, Cl As Long
Dim a As String
Application.ScreenUpdating = False
With Sheets("Заявка")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row - 1
Cl = .Cells(2, Columns.Count).End(xlToLeft).Column - 1
    'For i = 3 To Rw
        For j = 4 To Cl
            a = .Cells(2, j)
            Sheets(a).Range("D2:D" & Rw).Copy .Cells(3, j)
        Next
    'Next
End With
Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 0645897.xlsm (22.9 Kb)


ЯД-41001506838083
 
Ответить
СообщениеПеределал.[vba]
Код
Sub Svod()
Dim i As Long, j As Long, Rw As Long, Cl As Long
Dim a As String
Application.ScreenUpdating = False
With Sheets("Заявка")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row - 1
Cl = .Cells(2, Columns.Count).End(xlToLeft).Column - 1
    'For i = 3 To Rw
        For j = 4 To Cl
            a = .Cells(2, j)
            Sheets(a).Range("D2:D" & Rw).Copy .Cells(3, j)
        Next
    'Next
End With
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - gling
Дата добавления - 15.10.2020 в 20:21
gge29 Дата: Четверг, 15.10.2020, 22:21 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

gling, Спасибо огромное,вроде то что надо,завтра на основном испытаю
 
Ответить
Сообщениеgling, Спасибо огромное,вроде то что надо,завтра на основном испытаю

Автор - gge29
Дата добавления - 15.10.2020 в 22:21
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сбор данных с листов при формирование общей таблицы (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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