Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.67/6: Рейтинг темы: голосов - 6, средняя оценка - 4.67
0 / 0 / 0
Регистрация: 13.04.2016
Сообщений: 4
1

Создание макроса

14.04.2016, 00:16. Показов 1127. Ответов 6
Метки нет (Все метки)

Доброго времени суток!
Помогите автоматизировать процесс!
Есть две книги : книга1.xlsx и книга2.xlsx
Нужен макрос который заполнит форму в книге2 взяв данные из книги1.
А точнее, что бы он искал необходимые листы по ячейке A1 в "книге1", критерий для поиска значение ячейки B1, D1, F1 "книги2" и т.д.
А затем из найденных листов с помощью СУММЕСЛИ заполнил диапазоны ячеек С4:С20, E4:E20, G4:G20 и т.д.
С макросами очень туго.....
Надеюсь на вашу помощь!
Вложения
Тип файла: xlsx book1.xlsx (14.1 Кб, 4 просмотров)
Тип файла: xlsx book2.xlsx (10.1 Кб, 3 просмотров)
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
14.04.2016, 00:16
Ответы с готовыми решениями:

Создание макроса
Доброго времени суток господа. Помогите решить проблему. Есть информация в текстовом виде такого...

Создание макроса
Добрый вечер! Такое задание. Создать макрос, изменяющий шрифт выделенного текста на Arial 16,...

Создание макроса
Здравствуйте! Помогите пожалуйста. Создаю макрос , а при выполнении макроса выдает: запрашиваемый...

Создание макроса
Добрый день! Нужно создать такой макрос: - есть 3 файла эксель из одной программы...

6
5453 / 1483 / 364
Регистрация: 23.12.2010
Сообщений: 2,224
Записей в блоге: 1
14.04.2016, 12:00 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
Sub Заполнить_форму()
    Dim i&, j&, k&, L&, UslovieKnigi As Boolean, EndRow&, Sh, A, b, Prefix1$, Prefix2$, S$
    Dim wb_Ishodn As Workbook, wb_Cel As Workbook, wb_Tek As Workbook, Sh_Cel As Worksheet
    Set wb_Cel = ActiveWorkbook
    Set Sh_Cel = ActiveSheet
    For Each wb_Tek In Workbooks
        If (Not wb_Tek Is wb_Cel) And wb_Tek.Name <> "PERSONAL.XLSB" Then
            Set wb_Ishodn = wb_Tek
            UslovieKnigi = True
            Exit For
        End If
    Next
    If Not UslovieKnigi Then
          MsgBox "Выполнение макроса прервано." & vbCrLf & " Нет второй открытой книги."
          Exit Sub
    End If
    Prefix1 = "=SUMIF('[" & wb_Ishodn.Name & "]"
    Prefix2 = "C4,RC1,'[" & wb_Ishodn.Name & "]"
    With Sh_Cel
        A = .UsedRange.Value
        For j = 2 To UBound(A, 2) Step 2
            For Each Sh In wb_Ishodn.Worksheets
                If A(1, j) = Sh.Name Then
                    b = Sh.UsedRange.Value
                    L = Sh.UsedRange.Rows.Count
                    For i = 4 To UBound(A)
                        For k = 2 To UBound(b)
                            If A(i, 1) = b(k, 4) Then
                                .Cells(i, j + 1).FormulaR1C1 = Prefix1 & Sh.Name & "'!R2C4:R" & L & Prefix2 & Sh.Name & "'!R2C6:R" & L & "C6)"
                                ' или Просто ссылка, так как статьи не повторяются
                                ''.Cells(i, j + 1).FormulaR1C1 = "='[" & wb_Ishodn.Name & "]" & Sh.Name & "'!R" & k & "C6"
                                Exit For
                            End If
                        Next k
                    Next i
                End If
            Next Sh
        Next j
    End With
End Sub
Вложения
Тип файла: rar book2.rar (22.3 Кб, 2 просмотров)
0
0 / 0 / 0
Регистрация: 13.04.2016
Сообщений: 4
15.04.2016, 16:51  [ТС] 3
Большое спасибо, работает!
Но макрос ищет нужный лист по имени листа, а нужно чтобы он искал совпадение по содержимому ячейки A1...
0
5453 / 1483 / 364
Регистрация: 23.12.2010
Сообщений: 2,224
Записей в блоге: 1
15.04.2016, 17:03 4
Лучший ответ Сообщение было отмечено kav_134 как решение

Решение

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
Sub Заполнить_форму()
    Dim i&, j&, k&, L&, UslovieKnigi As Boolean, EndRow&, Sh, A, b, Prefix1$, Prefix2$, S$
    Dim wb_Ishodn As Workbook, wb_Cel As Workbook, wb_Tek As Workbook, Sh_Cel As Worksheet
    Set wb_Cel = ActiveWorkbook
    Set Sh_Cel = ActiveSheet
    For Each wb_Tek In Workbooks
        If (Not wb_Tek Is wb_Cel) And wb_Tek.Name <> "PERSONAL.XLSB" Then
            Set wb_Ishodn = wb_Tek
            UslovieKnigi = True
            Exit For
        End If
    Next
    If Not UslovieKnigi Then
          MsgBox "Выполнение макроса прервано." & vbCrLf & " Нет второй открытой книги."
          Exit Sub
    End If
    Prefix1 = "=SUMIF('[" & wb_Ishodn.Name & "]"
    Prefix2 = "C4,RC1,'[" & wb_Ishodn.Name & "]"
    With Sh_Cel
        A = .UsedRange.Value
        For j = 2 To UBound(A, 2) Step 2
            For Each Sh In wb_Ishodn.Worksheets
                If A(1, j) = Sh.[A1] Then
                    b = Sh.UsedRange.Value
                    L = Sh.UsedRange.Rows.Count
                    For i = 4 To UBound(A)
                        For k = 2 To UBound(b)
                            If A(i, 1) = b(k, 4) Then
                                .Cells(i, j + 1).FormulaR1C1 = Prefix1 & Sh.Name & "'!R2C4:R" & L & Prefix2 & Sh.Name & "'!R2C6:R" & L & "C6)"
                                ' или Просто ссылка, так как статьи не повторяются
                                ''.Cells(i, j + 1).FormulaR1C1 = "='[" & wb_Ishodn.Name & "]" & Sh.Name & "'!R" & k & "C6"
                                Exit For
                            End If
                        Next k
                    Next i
                End If
            Next Sh
        Next j
    End With
End Sub
1
0 / 0 / 0
Регистрация: 13.04.2016
Сообщений: 4
15.04.2016, 18:11  [ТС] 5
Хм... вообще перестал работать...
0
5453 / 1483 / 364
Регистрация: 23.12.2010
Сообщений: 2,224
Записей в блоге: 1
16.04.2016, 21:26 6
Запускать макрос надо находясь книге 2 на листе с нужной таблицей.
Возможно имена листов в книге 2 и в ячейках A1 книги 1 написаны неправильно - где-то есть лишние пробелы или обычно невидимый лидирующий апостроф.
0
0 / 0 / 0
Регистрация: 13.04.2016
Сообщений: 4
18.04.2016, 05:00  [ТС] 7
Спасибо за подсказку, проблема была в регистре, "Лист1" и "лист1".
Теперь все робит! )
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
18.04.2016, 05:00

Создание макроса
Помогите. Нужно чтобы при нажатии кнопки &quot;Узнать результат&quot; он переходил на страницу с результатами...

Создание макроса
Нужен макрос, который будет из определенной папки переименовывать файл excel удалением сначала 16...

Создание макроса new!
Нужно с помощью макроса отсортировать данные так, чтобы ФИО не повторялось, а код (столбец:код)...

Создание макроса на кнопку
Пожалуйста мне нужен код макроса который: При нажатии на кнопку заполнял формулами ячейки(ячейки...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru