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

Макрос вставки столбцов в нескольких таблицах

23.07.2016, 09:50. Просмотров 1900. Ответов 6
Метки нет (Все метки)

Уважаемые форумчане, прошу Вашей помощи.
Можно ли сделать макрос вставки столбцов в определённом выбранном месте таблицы, но не в одной таблице, а в нескольких таблицах расположенных в разных окнах файла эксель. Таблицы одинаковы по формату. Сейчас у меня стоят такие макросы.
На вставку столбцов:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub Добавить_столбец()
Prepare
If MsgBox("Добавить столбец?", vbQuestion + vbOKCancel) = vbOK Then
        ActiveSheet.Unprotect
        Dim nCol As Long
        nCol = ActiveCell.Column
        Columns(nCol).Insert
MsgBox "Столбец добавлен!", vbInformation, "Вставка столбцов"
Ended
End If
End Sub
На удаление столбцов:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub Удаление столбцов()
'
Prepare
If MsgBox("Столбец удалить?", vbQuestion + vbOKCancel) = vbOK Then
        Dim nCol As Long
        nCol = ActiveCell.Column
        Columns(nCol).Delete
MsgBox "Столбец удалён!", vbInformation, "Удаление столбцов"
Ended
End If
End Sub
Таблицы между собой взаимосвязаны с помощью формул. То есть есть главная таблица и все другие на неё завязаны
формулой
Код
=ИНДЕКС('Таблица заказов'!$A$1:$FN$4;СТРОКА();СТОЛБЕЦ()).
Но данная система работает не корректно, много ручного труда.
0
Лучшие ответы (1)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
23.07.2016, 09:50
Ответы с готовыми решениями:

Макрос вставки файлов в листы-Необходимо изменить ниже приведённый макрос
Необходимо изменить ниже приведённый макрос, взятый с форума. Необходима помощь. Буду признателен....

Макрос поиска и вставки
Здравствуйте. Вопрос жизни и смерти....помогите пожалуйста.. Нужен макрос или какое-то другое...

Макрос вставки изображений в Excel
Добрый день, уважаемые форумчане. Помогите, пожалуйста, с написанием макроса. Задача: на рабочем...

Макрос сбора и вставки данных
Здравствуйте! Помогите пожалуйста с задачей. В течение всего дня мне в отдельную папку (C:\test)...

Макрос для сравнения данных в двух таблицах, расположенных на одном рабочем листе
Помогите, пожалуйста, написать макрос который проверял бы значения в одной таблице со значениями в...

6
KoGG
5303 / 1374 / 325
Регистрация: 23.12.2010
Сообщений: 2,044
Записей в блоге: 1
25.07.2016, 10:51 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
Sub Добавить_столбцы()
    Prepare
    If MsgBox("Добавить столбец?", vbQuestion + vbOKCancel) = vbOK Then
        Dim nCol As Long, Sh As Worksheet
        nCol = ActiveCell.Column
        For Each Sh In Worksheets
            'Sh.Activate
            'Prepare
            Sh.Unprotect
            Sh.Columns(nCol).Insert
            'Ended
        Next Sh
        MsgBox "Столбцы добавлены!", vbInformation, "Вставка столбцов"
        Ended
    End If
End Sub
 
Sub Удаление_столбцов()
    Prepare
    If MsgBox("Столбец удалить?", vbQuestion + vbOKCancel) = vbOK Then
        Dim nCol As Long, Sh As Worksheet
        nCol = ActiveCell.Column
        For Each Sh In Worksheets
            'Sh.Activate
            'Prepare
            Sh.Unprotect
            Sh.Columns(nCol).Delete
            'Ended
        Next Sh
        MsgBox "Столбцы удалёны!", vbInformation, "Удаление столбцов"
        Ended
    End If
End Sub
Если процедуры Prepare и Ended работают только с активным листом, то их вызовы надо удалить в старых местах и раскомментировать дополнительные строки в циклах.
1
Vladivir1959
0 / 0 / 0
Регистрация: 23.07.2016
Сообщений: 10
25.07.2016, 22:35  [ТС] 3
Спасибо за подсказку, но к сожалению макрос работает не корректно в данной программе.
У меня таблицы в программе данные в которых располагаются в виде столбцов и в линейном виде, а при использовании данного макроса столбцы удаляются в обоих видах таблиц.
Можно ли привязать макрос к определённому виду таблиц?
В линейных таблицах проблема такая же, но я сам хотел решить её.
Ещё один вопрос каждая строка и столбец в таблицах имеют свой индивидуальный номер (номер продукции). Таких таблиц в программе 16 шт.
Можно ли макросом в одних таблицах удалять столбец, а в других строку используя индивидуальный номер или это из области фантастики???
Извиняюсь за наглость, но мне самому интересно. Такой спортивный интерес.
0
KoGG
5303 / 1374 / 325
Регистрация: 23.12.2010
Сообщений: 2,044
Записей в блоге: 1
26.07.2016, 10:05 4
Теоретически можно все.
Не видя конкретных таблиц - ничего.

Разрабатывая таблицы нужно задумываться об удобстве обработки данных макросами, так как Ваша необузданная фантазия в несколько раз увеличит трудоемкость написания макросов.
0
Vladivir1959
0 / 0 / 0
Регистрация: 23.07.2016
Сообщений: 10
26.07.2016, 22:52  [ТС] 5
Тут дело не в необузданной фантазии. Просто форма отчёта компании, в которой у нас семейный бизнес, не подразумевает какую либо автоматизацию и 2 года назад о макросах я сам не имел никакого представления. Так вот чтобы не сидеть по ночам с этим дурацким отчётом, я начал экспериментировать, начал с базы данных, вводил новые формулы, а когда узнал про макросы и их возможности, то поставил перед собой задачу сделать форму отчёта полностью автоматической. Я не программист, но как говорил, - появился спортивный интерес.
Эту программу я делал 1,5 года, не сразу, постепенно. Искал лучшие решения, переделывал и считаю, что своего добился. Программа работает, тормозит правда. Но вручную всё делать ещё дольше.
Я приложил часть программы, убрал второстепенные таблицы.
В данной программе таблицы "Отчёт" и "Таблица заказов" - главные таблицы. На них всё завязано.
0
Вложения
Тип файла: 7z Отчет склад ____ г. _____________ с БД Образец.7z (741.7 Кб, 7 просмотров)
KoGG
5303 / 1374 / 325
Регистрация: 23.12.2010
Сообщений: 2,044
Записей в блоге: 1
27.07.2016, 11:23 6
Лучший ответ Сообщение было отмечено Vladivir1959 как решение

Решение

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub Добавить_позицию_на_всех_листах()
If MsgBox("Добавить столбец/строку ?", vbQuestion + vbOKCancel) = vbOK Then
    Dim i&, Last&, El, Vert, Gor, CurCode$, U As Boolean, Sh As Worksheet, A, S$
    Vert = Array("отчет", "Таблица под отчет", "Накладная", "Отчёт о розничных продажах", "Приход и расход под реализацию", "Подарки (значение)", "Прайс лист", "Анализ движения продукции", "Срок годности", "Таб.для ревизии")
    Gor = Array("Таблица заказов", "Таблица заказов (2)", "Таб.уч.под реализацию", "Таблица подарков", "Таблица подарков (2)", "Таб. подарков за прош. мес.", "Таб. подарков за прош.мес.(2)")
    For Each El In Vert
        If ActiveSheet.Name = El Then
            CurCode = Cells(ActiveCell.Row, 1)
            U = True
            Exit For
        End If
    Next
    For Each El In Gor
        If ActiveSheet.Name = El Then
            CurCode = Cells(1, ActiveCell.Column)
            U = True
            Exit For
        End If
    Next
    If U = False Then Exit Sub
    If Len(CurCode) < 4 Then CurCode = Format$(Val(CurCode), "0000")
    Prepare
    For Each El In Vert
        With Worksheets(El)
            .Unprotect
            Last = .Cells(.Rows.Count, 1).End(xlUp).Row
            A = .Range("A1:A" & Last).Value
            For i = 9 To Last
                S = CStr(A(i, 1))
                If Len(S) < 4 Then S = Format$(Val(S), "0000")
                If S = CurCode Then
                    .Rows(i).Insert
                    Exit For
                End If
            Next i
            .Protect
        End With
    Next
    For Each El In Gor
        With Worksheets(El)
            .Unprotect
            Last = .Cells(1, .Columns.Count).End(xlToRight).Column
            A = Range(.Cells(1, 1), .Cells(1, Last)).Value
            For i = 6 To Last
                S = CStr(A(1, i))
                If Len(S) < 4 Then S = Format$(Val(S), "0000")
                If S = CurCode Then
                    .Columns(i).Insert
                    Exit For
                End If
            Next i
            .Protect
        End With
    Next
    Ended
    MsgBox "Столбцы/строки добавлены!", vbInformation, "Вставка столбцов/строк"
End If
End Sub
1
Vladivir1959
0 / 0 / 0
Регистрация: 23.07.2016
Сообщений: 10
27.07.2016, 15:02  [ТС] 7
Гениально.
Как удалить строки и столбцы теперь я сам сделаю.
0
27.07.2016, 15:02
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
27.07.2016, 15:02

Макрос для вставки символов юникода
Помогите. Нужно сделать макрос на вставку символа юникода по тиму Chrw(8292) чтоб он отображался в...

Макрос для вставки строк с текстом
В общем помогите написать код для вставки 2 строк от первой до последней на листе с учетом...

Макрос для вставки макроса в Excel
Собственно, вопрос в названии. Можно ли написать макрос, который будет добавлять другой макрос в...


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

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

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