Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Svetlanna
0 / 0 / 0
Регистрация: 12.11.2016
Сообщений: 1
1

Объединить несколько неоднотипных таблиц в одну

31.05.2017, 21:20. Просмотров 400. Ответов 1
Метки нет (Все метки)

Всем привет!

Помогите найти решение. Имеется несколько неоднотипных таблиц в одном файле, которые нужно объединить в одну.
Есть шаблон отчета и в него с каждого листа должны попасть столбцы с соответствующим названием. На форуме есть макрос с однотипными таблицами, но в данном случае он не подходит. Может кто еще сталкивался с такой проблемой, отзовитесь :-)
0
Вложения
Тип файла: xlsx Primer2.xlsx (11.2 Кб, 9 просмотров)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
31.05.2017, 21:20
Ответы с готовыми решениями:

Как объединить несколько таблиц в одну
Есть база книг в библиотеке с 20 полями, Название, описание, категория, картинка, страниц, isbn,...

Как объединить несколько .xls в одну?
Имеется очень много книг .xls в разных подпапках одной папки. Имена книг .xls могут совпадать. В...

Как объединить две процедуры в одну
Пожалуйста, помогите в редактировании скрипта. Есть скрипт № 1 Private Sub...

Как можно объединить две ячейки в одну программно?
Как можно объединить две ячейки в одну программно?

Нужно объединить около 30 книг Excel в одну соответственно по листам
Добрый день, нужно объединить около 30 книг Excell с одинаковым количеством и названием листов....

1
Alex77755
10981 / 3439 / 591
Регистрация: 13.02.2009
Сообщений: 10,217
01.06.2017, 04:52 2
Кликните здесь для просмотра всего текста
вариант
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
 
 Sub qwerty()
 Dim r, c, t, lr, m(), mi, lc, sh, lri, lci, ri, ci, rz()
 Dim z: Set z = CreateObject("Scripting.Dictionary")
 With Sheet1
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Cells(2, 1).Resize(lr, lc).ClearContents
    .Cells(2, 1).Resize(lr, lc).Borders.LineStyle = 0
    .Cells(1, 1).Resize(lr, lc).Interior.ColorIndex = -4142
    m = .Cells(1, 1).Resize(, lc).Value
    
    For c = 1 To lc
        z(m(1, c)) = c
    Next c
    
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> .Name Then
            lri = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
            lci = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
            mi = sh.Cells(1, 1).Resize(lri, lci).Value
            ReDim rz(2 To lri, 1 To lci)
            For ri = 2 To lri
                For ci = 1 To lci
                    c = z(mi(1, ci))
                    If Len(c) > 0 Then rz(ri, c) = mi(ri, ci)
                Next ci
            Next ri
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        
       .Cells(lr, 1).Resize(lri - 1, lc) = rz
       
        For r = 7 To 10
            .Cells(lr, 1).Resize(lri - 1, lc).Borders(r).LineStyle = 1
        Next r
        
        End If
    Next
 
 End With
 
 End Sub
1
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
01.06.2017, 04:52

Объединить несколько recordset в один
Добрый день. Выгружаю данные из двух файлов Excel (База1 и База2 с одинаковой структурой) в...

Объединить столбец слов в одну строку, разделив слова запятыми и в кавычках
Имеется очень большой столбец слов, нужно из него сформировать массив для ЯП такого формата: array...

Объединить несколько макросов в один макрос
Подскажите пожалуйста как объединить в один макрос несколько: 1 макрос. Sub...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.