Нужно сократить код (Один код для разных label_click)

@faust21 · Регистрация: 21.01.2020

Студворк — интернет-сервис помощи студентам

Друзья, помогите сократить код!
Идет перебор Label_click (1-22), где каждому соответствует ячейка (h2:h23)
И если подскажете как обновить данные на Userform без использования кода :

Visual Basic
1
2
Unload Должники
Должники.Show

, буду вам благодарен.
Спасибо

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
Private Sub Label1_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h2").Value = Z
Unload Должники
Должники.Show
End Sub
 
Private Sub Label2_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h3").Value = Z
Unload Должники
Должники.Show
End Sub
 
 
Private Sub Label3_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h4").Value = Z
Unload Должники
Должники.Show
End Sub
 
Private Sub Label4_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h5").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label5_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h6").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label6_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h7").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label7_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h8").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label8_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h9").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label9_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h10").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label10_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h11").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label11_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h12").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label12_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h13").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label13_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h14").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label14_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h15").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label15_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h16").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label16_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h17").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label17_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h18").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label18_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h19").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label19_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h20").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label20_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h21").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label21_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h22").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label22_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h23").Value = Z
Unload Должники
Должники.Show
End Sub

@Hugo121 · 22.07.2020, 10:05

Вызвать процедуру, куда передать адрес ячейки.

@faust21 · 22.07.2020, 10:06 **[ТС]**

Hugo121, Можете показать на примере?

@Hugo121 · 22.07.2020, 10:09

Примера у меня нет

а код вот, без проверки:

Visual Basic
1
2
3
4
5
6
7
8
9
Private Sub Label1_Click()
    procedura "h2"
End Sub
 
Sub procedura(adr As String)
    Sheets(Лист31.Name).Range(adr).Value = CDate(ActiveSheet.Range("A1"))
    Unload Должники
    Должники.Show
End Sub

Обновить элемент/объект у должников может быть поможет строка
объект.repaint

@amd48 · 22.07.2020, 10:10

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub lc(strRange as string)
    Sheets(Лист31.name).Range(strRange).Value =CDate(ActiveSheet.Range("A1"))
    Unload Должники
    Должники.Show
End Sub
 
Private Sub Label1_Click()
 lc "h2"
End Sub
 
Private Sub Label2_Click()
 lc "h3"
End Sub
и т.д.

@Hugo121 · 22.07.2020, 10:13

Вообще думаю можно ещё оптимизнуть тут:
Sheets(Лист31.name) заменить на Лист31

@faust21 · 22.07.2020, 10:14 **[ТС]**

А перебор Label_click 'ов не существует в VBA?

passedbyz · 22.07.2020, 10:32

faust21, а может вам вместо кучи лэйблов взять простой листбокс? все проблемы снимутся волшебным образом.

@faust21 · 22.07.2020, 10:34 **[ТС]**

Я бы забил на это дело, но потребовалось внести дополнения с разными переменными, а у меня их куча(((
Label1_click (от 1 до 22)
Погасил задолженность " & Label23.Caption (от 23 до 44)
"на сумму" & Label46.Caption (от 46 до 66)
Range("h2") - от H2 до H23
Sheets(Лист1.name).Range("L3").ClearContents - лист (от 1 до 22)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Label1_Click()
r = MsgBox("Погасил задолженность " & Label23.Caption & "на сумму" & Label46.Caption & "руб.", vbYesNo)
If r = vbYes Then
  Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
       Z = CDate(cell)
      Sheets(Лист31.name).Range("h2").Value = Format(Z, "dd MMMM") & vbNewLine & Label46.Caption
      Sheets(Лист1.name).Range("L3").ClearContents
Unload Должники
Должники.Show
End If
End Sub

Добавлено через 1 минуту
passedbyz, мне не подходит(

passedbyz · 22.07.2020, 10:44

Сообщение от faust21

мне не подходит(

а аргументы какие? Очень интересно услышать!

@faust21 · 22.07.2020, 10:50 **[ТС]**

passedbyz, Логика простая - хочу вести учет должников и отмечать по клику на дату, контрагента, суммы, и даты оплаты - дату и сумму гашения задолженности.
Может быть есть более элегантное решение, но моих небольших познаний в области VBA не хватает(

passedbyz · 22.07.2020, 11:07

если честно - мне влом разбираться за "большое спасибо" в вашей нарисованной ПРОГРАММЕ.
маленькая иллюстрация моего видения проблемы на картинке...

@faust21 · 22.07.2020, 11:11 **[ТС]**

passedbyz, Вы сами попросили аргументы почему не подходит. Ваше видение мне не подходит.

passedbyz · 22.07.2020, 11:18

Сообщение от faust21

Ваше видение мне не подходит

Звучит с каждым постом убедительнее!
Удачи!
22 клика по 13 строк (300 строк итого) это гораздо лучше чем 5-7 строк нормального кода!

@faust21 · 22.07.2020, 11:28 **[ТС]**

passedbyz, ваш код может быть сколько угодно нормальным, только толку от него если результат его не подходит для моих целей. Чтобы делать вывод о том что лучше/хуже, как минимум, надо разобраться в вопросе. Если желания помогать нет, то я вас не задерживаю.

passedbyz · 22.07.2020, 11:33

ну не хотите нормального решения - Ваше дело. В листбоксе, кстати, может быть несколько столбцов. Но Вам же это не интересно, мы же не ищем простого пути...

@Burk · 22.07.2020, 11:34

faust21, а нельзя ли пояснить чего хотите-то, чтобы при клике на лэбл менялось бы значение в ячейках h2:h23 или при изменении значений в одной из этих ячеек менялось бы значение в соответствующей лэбл.
Хочу заметить, что писать для каждой лэбл одну и ту же процедуру неразумно. Достаточно объявить модуль класса этих лэблов, создать массив переменных этого класса и достаточно только одного макроса реакции на клик. Если сами не разберётесь, то нарисую позже, но сначала ответы на мои вопросы.

@snipe · 22.07.2020, 11:40

на Label не устанавливается фокус соответственно определить какой из лабелов активный - не возможно

Сообщение от faust21

А перебор Label_click 'ов не существует в VBA?

перебора событий в форме просто нет,
так что в каждом событии Click самое простое прописать вызов функции
как это сделали Hugo121,amd48,

@Burk · 22.07.2020, 11:46

а, кстати, макрос инициализации формы где? И конечно для того, чтобы изменить одно значение, отгружаете и загружаете форму это очень неразумно.

@faust21 · 22.07.2020, 12:09 **[ТС]**

passedbyz, Если бы я не искал простого пути, я бы не задавал вопросов по оптимизации. Повторяю еще раз, ваше решение мне не подходит.

Burk, Конечно объясню:
по клику лэйблов в строке на дату, контрагента, сумму, и дату оплаты берем дату из ячейки ActiveSheet.Range("A1") и сумму из Label46.Caption и вставляем в ячейку Sheets(Лист31.name).Range("h2").Value
(Потом label (Дата оплаты) подгружает данные из этой ячейки в другом коде).
Надеюсь написал понятно.
Если грубо говорить кликаю в строку по должнику и попадаю в любой лйбл на этой строке который проставляет дату, которая берется из ячейки активного листа, и сумма, которая берется из лейбла суммы.

Если подробнее, то дабы устранить случайные клики по лейблам вызываю msg box строки, в которой упоминается имя контрагента (из лейбла контрагента) и сумма (из лейбла суммы). С вопросом ДА/НЕТ.
Если да то проставляем дату активного листа (ячейка a1) в ячейку H(2-23) + сумму
После чего стираю данные из ячейки L3 активного листа (в котором фикс стоит сумма долга)
И обновляю форму, на которой я увижу Дату когда был долг, контрагент у которого был долг, и Дату оплаты долга с его суммой.

Сообщение от Burk

Хочу заметить, что писать для каждой лэбл одну и ту же процедуру неразумно.

Абсолютно с вами согласен, но я пока не умею)

Сообщение от Burk

изменить одно значение, отгружаете и загружаете форму это очень неразумно.

Я пытался через repaint но не получилось.

Спасибо

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки 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. На борту пять. . .	Камера 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. Пошагово создадим проект для загрузки изображения. . .

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	22.07.2020, 10:05
	Вызвать процедуру, куда передать адрес ячейки. 0

@faust21 1 / 1 / 0 Регистрация: 21.01.2020 Сообщений: 184
	22.07.2020, 10:06 [ТС]
	Hugo121, Можете показать на примере? 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	22.07.2020, 10:13
	Вообще думаю можно ещё оптимизнуть тут: Sheets(Лист31.name) заменить на Лист31 0

@faust21 1 / 1 / 0 Регистрация: 21.01.2020 Сообщений: 184
	22.07.2020, 10:14 [ТС]
	А перебор Label_click 'ов не существует в VBA? 0

passedbyz Заблокирован
	22.07.2020, 10:32
	faust21, а может вам вместо кучи лэйблов взять простой листбокс? все проблемы снимутся волшебным образом. 0

@faust21 1 / 1 / 0 Регистрация: 21.01.2020 Сообщений: 184
	22.07.2020, 10:50 [ТС]
	passedbyz, Логика простая - хочу вести учет должников и отмечать по клику на дату, контрагента, суммы, и даты оплаты - дату и сумму гашения задолженности. Может быть есть более элегантное решение, но моих небольших познаний в области VBA не хватает( Миниатюры 0

passedbyz Заблокирован
	22.07.2020, 11:07
	если честно - мне влом разбираться за "большое спасибо" в вашей нарисованной ПРОГРАММЕ. маленькая иллюстрация моего видения проблемы на картинке... Миниатюры 0

@faust21 1 / 1 / 0 Регистрация: 21.01.2020 Сообщений: 184
	22.07.2020, 11:11 [ТС]
	passedbyz, Вы сами попросили аргументы почему не подходит. Ваше видение мне не подходит. 0

@faust21 1 / 1 / 0 Регистрация: 21.01.2020 Сообщений: 184
	22.07.2020, 11:28 [ТС]
	passedbyz, ваш код может быть сколько угодно нормальным, только толку от него если результат его не подходит для моих целей. Чтобы делать вывод о том что лучше/хуже, как минимум, надо разобраться в вопросе. Если желания помогать нет, то я вас не задерживаю. 0

passedbyz Заблокирован
	22.07.2020, 11:33
	ну не хотите нормального решения - Ваше дело. В листбоксе, кстати, может быть несколько столбцов. Но Вам же это не интересно, мы же не ищем простого пути... 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.07.2020, 11:34
	faust21, а нельзя ли пояснить чего хотите-то, чтобы при клике на лэбл менялось бы значение в ячейках h2:h23 или при изменении значений в одной из этих ячеек менялось бы значение в соответствующей лэбл. Хочу заметить, что писать для каждой лэбл одну и ту же процедуру неразумно. Достаточно объявить модуль класса этих лэблов, создать массив переменных этого класса и достаточно только одного макроса реакции на клик. Если сами не разберётесь, то нарисую позже, но сначала ответы на мои вопросы. 1

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.07.2020, 11:46
	а, кстати, макрос инициализации формы где? И конечно для того, чтобы изменить одно значение, отгружаете и загружаете форму это очень неразумно. 0