Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 08.07.2020, 12:55   #1
Alexey200999
Пользователь
 
Регистрация: 21.08.2018
Сообщений: 15
По умолчанию Макрос, по условию подставляет данные в другие таблицы и возвращает результат

Доброго времени суток, уважаемые форумчане.
Помогите пожалуйста в разработке макроса:
Необходимо, что бы данные из этой таблицы (дата договора, дата оплаты 1-5, сумма оплаты 1-5), подставлялись в расчетные таблицы на листах 1-5, в соответствии с условием (столбец условие),
если условие 1 - то в расчетную таблицу на листе 1,
если условие 2 - то в расчетную таблицу на листе 2,
если условие 3 - то в расчетную таблицу на листе 3,
если условие 4 - то в расчетную таблицу на листе 4,
если условие 5 - то в расчетную таблицу на листе 5,
И в крайний столбец "Итог" этой таблицы возвращалось итоговое значение из таблиц

Строк в данной таблице гораздо больше, и их количество постоянно разное
Вложения
Тип файла: xlsx Образец.xlsx (14.8 Кб, 10 просмотров)
Alexey200999 вне форума Ответить с цитированием
Старый 08.07.2020, 14:15   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Посколько файл формата xlsx то просьба
Цитата:
Помогите пожалуйста в разработке макроса:
равняется "сделайте все вместо меня"?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 08.07.2020, 14:49   #3
Alexey200999
Пользователь
 
Регистрация: 21.08.2018
Сообщений: 15
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Посколько файл формата xlsx то просьба
равняется "сделайте все вместо меня"?
Если бы был силен в VBA, то и не обращался бы за помощью...
Alexey200999 вне форума Ответить с цитированием
Старый 14.07.2020, 10:11   #4
Alexey200999
Пользователь
 
Регистрация: 21.08.2018
Сообщений: 15
По умолчанию

Sub Macr()
All = Cells.SpecialCells(xlCellTypeLastCe ll).Row
With Sheets("Данные")
For a = 1 To All
Set shData = Worksheets("Данные")
If Cells(a, 3) = 1 Then
Set sh = Worksheets("1")
GoTo EngineNotStarted
ElseIf Cells(a, 3) = 2 Then
Set sh = Worksheets("2")
GoTo EngineNotStarted
ElseIf Cells(a, 3) = 3 Then
Set sh = Worksheets("3")
GoTo EngineNotStarted
ElseIf Cells(a, 3) = 4 Then
Set sh = Worksheets("4")
GoTo EngineNotStarted
ElseIf Cells(a, 3) = 5 Then
Set sh = Worksheets("5")

EngineNotStarted:

sh.Range("A2") = _
shData.Cells(a, 2).Value2

sh.Range("B5") = _
shData.Cells(a, 4).Value2
sh.Range("C5") = _
shData.Cells(a, 5).Value2
sh.Range("B6") = _
shData.Cells(a, 6).Value2
sh.Range("C6") = _
shData.Cells(a, 7).Value2
sh.Range("B7") = _
shData.Cells(a, 8).Value2
sh.Range("C7") = _
shData.Cells(a, 9).Value2
sh.Range("B8") = _
shData.Cells(a, 10).Value2
sh.Range("C8") = _
shData.Cells(a, 11).Value2
sh.Range("B9") = _
shData.Cells(a, 12).Value2
sh.Range("C9") = _
shData.Cells(a, 13).Value2

shData.Cells(a, 14).Value2 = _
sh.Range("D10")

End If
Next a
End With
End Sub

Последний раз редактировалось Alexey200999; 14.07.2020 в 10:16.
Alexey200999 вне форума Ответить с цитированием
Старый 14.07.2020, 12:11   #5
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

это Ваш рабочий код или набросок?




Код:
Sub Macr()
    Dim All As Integer
    Dim shData As Worksheet
    Dim sh As Worksheet
    Dim a As Integer
    Set shData = Worksheets("Данные")
    All = shData.Cells.SpecialCells(xlCellTypeLastCell).Row
    For a = 1 To All
        Debug.Print shData.Cells(a, 3).Value2
        Select Case (Trim(shData.Cells(a, 3).Value2))
            Case "1", "2", "3", "4", "5"
                Set sh = Worksheets(Trim(shData.Cells(a, 3).Value2))
                sh.Range("A2") = _
                shData.Cells(a, 2).Value2
                sh.Range("B5") = _
                shData.Cells(a, 4).Value2
                sh.Range("C5") = _
                shData.Cells(a, 5).Value2
                sh.Range("B6") = _
                shData.Cells(a, 6).Value2
                sh.Range("C6") = _
                shData.Cells(a, 7).Value2
                sh.Range("B7") = _
                shData.Cells(a, 8).Value2
                sh.Range("C7") = _
                shData.Cells(a, 9).Value2
                sh.Range("B8") = _
                shData.Cells(a, 10).Value2
                sh.Range("C8") = _
                shData.Cells(a, 11).Value2
                sh.Range("B9") = _
                shData.Cells(a, 12).Value2
                sh.Range("C9") = _
                shData.Cells(a, 13).Value2
                shData.Cells(a, 14).Value2 = _
                sh.Range("D10")
        End Select
    Next a
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 14.07.2020, 12:15   #6
Alexey200999
Пользователь
 
Регистрация: 21.08.2018
Сообщений: 15
По умолчанию

Aleksandr H.,

Это набросок, данных в каждой строке более пятидесяти, в рассчетных таблицах гораздо больше рассчетов, а строк на первой странице более 1000.
Alexey200999 вне форума Ответить с цитированием
Старый 14.07.2020, 12:24   #7
Alexey200999
Пользователь
 
Регистрация: 21.08.2018
Сообщений: 15
По умолчанию

Aleksandr H.,

Спасибо за доработку, высший класс! Суть понятна, буду допиливать. Огромнейшее СПАСИБО!
Alexey200999 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перенос данных с общего листа на другие по условию кнопка 01011991 Microsoft Office Excel 0 23.01.2015 16:05
учебная задача: запрос SQL, который выводит из таблицы данные по условию Nixon91 Помощь студентам 1 13.05.2014 06:45
Макрос подставляет формулы при нажатии на кнопку Bocul Microsoft Office Excel 9 04.09.2013 23:47
макросом выдернуть слова из одного столбца в другие по мудреному условию z00lu Microsoft Office Excel 10 23.06.2013 15:35
Внесение в поле таблицы сумму значений из другой таблицы по условию Сурка SQL, базы данных 2 25.12.2011 17:47