Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
 
Рейтинг 4.60/5: Рейтинг темы: голосов - 5, средняя оценка - 4.60
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135

Друзья немного сократить код VBA

06.12.2016, 15:58. Показов 1136. Ответов 20
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Ребят, написал код. Но он слишком большой. очень много If. Как бы мне его сократить.
Механика кода проста. Есть сводная таблица, он оттуда просматривает значения и суммирует их вставляя в определенные ячейки результат моего вычисления. Т.е он находит сначала 2011 и все что меньше, выдает сумму, потом по 2012 также и до 2016.

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
Sub syma()
Dim w As Worksheet
Dim s1, s2, s3, s4, s5, s6, x As Integer
Dim a, b, c, d, e, f, lr As String
a = "2012"
b = "2013"
d = "2014"
e = "2015"
f = "2016"
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set w = ActiveWorkbook.Sheets("Ò3")
For x = 5 To lr
c = Cells(x, 1)
If (Left(c, 4) < a) Then
s1 = s1 + Cells(x, 2)
w.Cells(4, 3) = s1
End If
 
If (Left(c, 4) = a) Then
s2 = s2 + Cells(x, 2)
w.Cells(5, 3) = s2
End If
 
If (Left(c, 4) = b) Then
s3 = s3 + Cells(x, 2)
w.Cells(6, 3) = s3
End If
If (Left(c, 4) = d) Then
s4 = s4 + Cells(x, 2)
w.Cells(7, 3) = s4
End If
If (Left(c, 4) = e) Then
s5 = s5 + Cells(x, 2)
w.Cells(8, 3) = s5
End If
If (Left(c, 4) = f) Then
s6 = s6 + Cells(x, 2)
w.Cells(9, 3) = s6
End If
 
Next x
End Sub
0
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
06.12.2016, 15:58
Ответы с готовыми решениями:

Слишком длинный типовой код в UserForm VBA. Как сократить код?
Программа выдает ошибку о слишком длинном коде. 1. Есть форма, в форме Multipage с 30 вкладками, на каждой вкладке 20 кнопок. 2. Тексты...

VBA: Сократить текст каждой ячейки столбца Excel
Здравствуйте, В столбце А выбираю из выпадающего списка (А-тест, А1-тест/тест, АА1-тест/тест/тест). Мне нужно, чтобы после того, как я...

Друзья сделайте за меня код на рнр!
Задача1.В данном файле, содержащем целые числа, определить элемент с максимальным произведением цифр. Задача2.Базы данных: Автомобили...

20
15155 / 6428 / 1731
Регистрация: 24.09.2011
Сообщений: 9,999
06.12.2016, 16:06
hannu, похоже тут функцией СУММЕСЛИ можно обойтись, приложите файл-пример.
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 16:25  [ТС]
Вопрос в том, что там, обычная таблица завязана на сводную.
Т.е получается динамический диапазон.
Т.е когда то данных больше, когда то меньше. А при помощи функции нужно обозначать определенный диапазон
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 16:28  [ТС]
Вот прикладываю.
Вложения
Тип файла: zip ЕРЗ_Москва.zip (179.0 Кб, 8 просмотров)
0
1866 / 1186 / 192
Регистрация: 27.03.2009
Сообщений: 4,603
06.12.2016, 16:57
типа такого?
Вложения
Тип файла: xls ЕРЗ_Москва.xls (59.5 Кб, 2 просмотров)
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 17:02  [ТС]
Не совсем, он из сводной таблицы(Лист С3) должен брать необходимые данные, суммировать их и вставлять в Т3.
Макрос на это есть, но там много переменных и If. Мне челвоек сказал что можно при помощи While сделать,
он будет смотреть в сводной таблицы данные, если 4 символа левых от даты = 2016 то суммировать все ячейки с кол-во обьекта и 2016 годом. Ну и также по 2015 , 2014, 2013
0
1866 / 1186 / 192
Регистрация: 27.03.2009
Сообщений: 4,603
06.12.2016, 17:08
hannu, а посмотри сам макрос. Да и... там нет третьего листа. В данном случае данные берет с первого, и результат ставит на 3 (то есть O3).

Добавлено через 1 минуту
а если нужно с 1 во второй (С3 в ТЗ), то просто в макросе поменять листы

Добавлено через 30 секунд
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
Sub syma()
Dim w As Worksheet
Dim s1, s2, s3, s4, s5, s6, x As Integer
Dim a, b, c, d, e, f, lr As String
a = "2012"
b = "2013"
d = "2014"
e = "2015"
f = "2016"
lr = Cells(Rows.Count, 1).End(xlUp).Row - 1
Set w = ActiveWorkbook.Sheets("O3")
For x = 5 To lr
c = Cells(x, 1)
Select Case Left(c, 4)
Case a: w.Cells(5, 3) = w.Cells(5, 3) + Cells(x, 2)
Case b: w.Cells(6, 3) = w.Cells(6, 3) + Cells(x, 2)
Case d: w.Cells(7, 3) = w.Cells(7, 3) + Cells(x, 2)
Case e: w.Cells(8, 3) = w.Cells(8, 3) + Cells(x, 2)
Case f: w.Cells(9, 3) = w.Cells(9, 3) + Cells(x, 2)
Case Else
w.Cells(4, 3) = w.Cells(4, 3) + Cells(x, 2)
End Select
Next x
End Sub
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 17:15  [ТС]
Точно, через case. Блин сейчас поковыряюсь, сделаю. А теперь другой момент, в случае если данные поменяются он их проссумирует с предыдущими. тут я так понимаю нужен цикл на обнуление или как?
0
1866 / 1186 / 192
Регистрация: 27.03.2009
Сообщений: 4,603
06.12.2016, 17:16
то есть?
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 17:18  [ТС]
Получается, я обновил сводную запустил макрос. Потом данные поменял запустил и он новые данные сложит с предыдущими, которые не очистились.

Получается если на сводной таблице 3 раза запустить код он будет тупо складывать и складывать складывать и складывать.
А нужно чтобы один раз выдал необходимое значение.
0
1866 / 1186 / 192
Регистрация: 27.03.2009
Сообщений: 4,603
06.12.2016, 17:18
Visual Basic
1
w.Range(w.Cells(4, 3), w.Cells(9, 3)).ClearContents
типа такого??? это перед циклом, после присвоения листа
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 17:27  [ТС]
да я так понимаю он очищает диапазон ячеек. Но тогда нужно будет 2 кнопки делать. Одной кнопкой очищать а второй вносить.

И второй небольшой вопрос, как сделать, чтобы он не по каждому столбцу а например по Case:a находил значения меньше 2012 и данные по колличеству квартир и по площади отражал также в таблице Т3

Добавлено через 3 минуты
Т.е для следующих данных нужно будет составлять такой же код, но только смещать его верно?
0
3218 / 967 / 223
Регистрация: 29.05.2010
Сообщений: 2,087
06.12.2016, 17:31
А почему нельзя составить сводную таблицу на листе ТЗ напрямую с данных?
0
1866 / 1186 / 192
Регистрация: 27.03.2009
Сообщений: 4,603
06.12.2016, 17:33
hannu, не 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
Sub syma()
Dim w As Worksheet
Dim x As Integer
Dim a, b, c, d, e, f, lr As String
a = "2012"
b = "2013"
d = "2014"
e = "2015"
f = "2016"
lr = Cells(Rows.Count, 1).End(xlUp).Row - 1
Set w = ActiveWorkbook.Sheets("Т3")
w.Range(w.Cells(4, 9), w.Cells(9, 9)).ClearContents
w.Range(w.Cells(4, 11), w.Cells(9, 11)).ClearContents
w.Range(w.Cells(4, 13), w.Cells(9, 13)).ClearContents
For x = 5 To lr
c = Cells(x, 1)
Select Case Left(c, 4)
Case a: w.Cells(5, 9) = w.Cells(5, 9) + Cells(x, 2)
Case b: w.Cells(6, 9) = w.Cells(6, 9) + Cells(x, 2)
Case d: w.Cells(7, 9) = w.Cells(7, 9) + Cells(x, 2)
Case e: w.Cells(8, 9) = w.Cells(8, 9) + Cells(x, 2)
Case f: w.Cells(9, 9) = w.Cells(9, 9) + Cells(x, 2)
Case Else
w.Cells(4, 9) = w.Cells(4, 9) + Cells(x, 2)
w.Cells(4, 11) = w.Cells(4, 11) + Cells(x, 4)
w.Cells(4, 13) = w.Cells(4, 13) + Cells(x, 6)
End Select
Next x
End Sub
если у тебя файл такой же как выставлен, посмотри после выполнения макроса лист ТЗ
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 17:43  [ТС]
Потому что сводная таблица привязана у меня к выгрузке и делается совершенно из другого массива данных. А таблица это некоторое визуальное отображение части необходимой информации

Добавлено через 10 минут
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
Option Explicit
 
Sub syma()
Dim w As Worksheet
Dim x As Integer
Dim a, b, c, d, e, f, lr As String
a = "2012"
b = "2013"
d = "2014"
e = "2015"
f = "2016"
lr = Cells(Rows.Count, 1).End(xlUp).Row - 1
Set w = ActiveWorkbook.Sheets("Т3")
w.Range(w.Cells(4, 3), w.Cells(9, 3)).ClearContents
w.Range(w.Cells(4, 5), w.Cells(9, 5)).ClearContents
w.Range(w.Cells(4, 7), w.Cells(9, 7)).ClearContents
For x = 5 To lr
c = Cells(x, 1)
Select Case Left(c, 4)
Case a: w.Cells(5, 3) = w.Cells(5, 3) + Cells(x, 2)
Case b: w.Cells(6, 3) = w.Cells(6, 3) + Cells(x, 2)
Case d: w.Cells(7, 3) = w.Cells(7, 3) + Cells(x, 2)
Case e: w.Cells(8, 3) = w.Cells(8, 3) + Cells(x, 2)
Case f: w.Cells(9, 3) = w.Cells(9, 3) + Cells(x, 2)
Case Else
w.Cells(4, 3) = w.Cells(4, 3) + Cells(x, 2)
w.Cells(4, 5) = w.Cells(4, 5) + Cells(x, 4)
w.Cells(4, 7) = w.Cells(4, 7) + Cells(x, 6)
 
End Select
Next x
End Sub
вот так он вставляет в те значения куда нужно. Единственный момент он заполняет только первую строку по 2011, остальные пустые.
0
1866 / 1186 / 192
Регистрация: 27.03.2009
Сообщений: 4,603
06.12.2016, 17:45
а потому что там год во всех строчках меньше 2012
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 17:46  [ТС]
а как же быть с 2013, 2014. ?? 2015 и 2016
0
1866 / 1186 / 192
Регистрация: 27.03.2009
Сообщений: 4,603
06.12.2016, 17:48
hannu, ввести в отчет :-)
0
0 / 0 / 0
Регистрация: 08.04.2015
Сообщений: 135
06.12.2016, 17:51  [ТС]
Так там они есть. Просто почему то не собираются

Добавлено через 1 минуту
там фильтр стоит в сводной, если его убрать, как раз даты другие появятся.
0
1866 / 1186 / 192
Регистрация: 27.03.2009
Сообщений: 4,603
06.12.2016, 17:55
hannu, последний раз. Лист СЗ - 16 строк, заполнены с 5 по 15 датами, где год меньше 2012.
Остальные данные с потолка возьму
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
06.12.2016, 17:55
Помогаю со студенческими работами здесь

Сократить код
Hello World, помогите придумать обработку замены + 1 +2 +3 итд в цикл, тем самым сократить код For n = 1 To 41 Step 10 If...

Сократить код
Добрый вечер! Можно ли как-нибудь сократить код? public void newDesign(JPanel panel) { for (int i = 0; i &lt; 5; i++) { if...

Сократить JS-код
Добрый день. Как можно сократить этот JS-код? $(document).ready(function(){ $(&quot;.btn-mymodal&quot;).click(function() { ...

Сократить код
Необходимо чтобы после ввода матрицы, программа находила минимакс по строкам и максимин по столбцам, прошу помочь в максимальном сокращении...

Сократить код
Есть кусок кода, он рабочий, хотелось бы сделать его компактнее. Вероятно case и массивы, но чёсь не получается. На Руси издревле помогали...


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

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Новые блоги и статьи
Конвертировать закладки radiotray-ng в m3u-плейлист
damix 19.02.2026
Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI
Eddy_Em 18.02.2026
Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .
Символьное дифференцирование
igorrr37 13.02.2026
/ * Программа принимает математическое выражение в виде строки и выдаёт его производную в виде строки и вычисляет значение производной при заданном х Логарифм записывается как: (x-2)log(x^2+2) -. . .
Камера Toupcam IUA500KMA
Eddy_Em 12.02.2026
Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу
zbw 12.02.2026
И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.
«Знание-Сила»
zbw 12.02.2026
«Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров
8Observer8 12.02.2026
Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .
SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image)
8Observer8 11.02.2026
Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru