Нужно сократить код (Один код для разных 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

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

Burk, Вот весь код формы. Гигантский и не оптимизированный

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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
Private Sub CommandButton1_Click()
ДолжникиСтогоМес.Show
End Sub
 
Private Sub Label1_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    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")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h23").Value = Z
Unload Должники
Должники.Show
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Label23_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
 
Private Sub Label24_Click()
r = MsgBox("Погасил задолженность " & Label24.Caption & "на сумму" & Label47.Caption & "руб.", vbYesNo)
If r = vbYes Then
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h3").Value = Format(Z, "dd MMMM") & vbNewLine & Label46.Caption
            Sheets(Лист2.name).Range("L3").ClearContents
Unload Должники
Должники.Show
End If
End Sub
 
 
Private Sub Label25_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h4").Value = Z
Unload Должники
Должники.Show
End Sub
 
Private Sub Label26_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h5").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label27_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h6").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label28_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h7").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label29_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h8").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label30_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h9").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label31_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h10").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label32_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h11").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label33_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h12").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label34_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h13").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label35_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h14").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label36_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h15").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label37_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h16").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label38_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h17").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label39_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h18").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label40_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h19").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label41_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h20").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label42_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h21").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label43_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h22").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label44_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h23").Value = Z
Unload Должники
Должники.Show
End Sub
'''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Label46_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h2").Value = Z
Unload Должники
Должники.Show
End Sub
 
Private Sub Label47_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h3").Value = Z
Unload Должники
Должники.Show
End Sub
 
 
Private Sub Label48_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h4").Value = Z
Unload Должники
Должники.Show
End Sub
 
Private Sub Label49_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h5").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label50_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h6").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label51_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h7").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label52_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h8").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label53_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h9").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label54_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h10").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label55_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h11").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label56_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h12").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label57_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h13").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label45_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h14").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label58_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h15").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label59_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h16").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label60_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h17").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label61_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h18").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label62_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h19").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label63_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h20").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label64_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h21").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label65_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h22").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label66_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h23").Value = Z
Unload Должники
Должники.Show
End Sub
'''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Label97_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h2").Value = Z
Unload Должники
Должники.Show
End Sub
 
Private Sub Label98_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h3").Value = Z
Unload Должники
Должники.Show
End Sub
 
 
Private Sub Label99_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h4").Value = Z
Unload Должники
Должники.Show
End Sub
 
Private Sub Label100_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h5").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label101_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h6").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label102_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h7").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label103_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h8").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label104_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h9").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label105_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h10").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label106_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h11").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label107_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h12").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label108_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h13").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label109_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h14").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label110_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h15").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label111_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h16").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label112_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h17").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label113_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h18").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label114_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h19").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label115_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h20").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label116_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h21").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label117_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h22").Value = Z
Unload Должники
Должники.Show
End Sub
Private Sub Label118_Click()
 Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h23").Value = Z
Unload Должники
Должники.Show
End Sub
'''''''''''''''''''''''''''''''''
 
 
Private Sub UserForm_Activate()
'День
Label1.Caption = Sheets(Лист1.name).Range("A1").Value
Label2.Caption = Sheets(Лист2.name).Range("A1").Value
Label3.Caption = Sheets(Лист3.name).Range("A1").Value
Label4.Caption = Sheets(Лист4.name).Range("A1").Value
Label5.Caption = Sheets(Лист5.name).Range("A1").Value
Label6.Caption = Sheets(Лист6.name).Range("A1").Value
Label7.Caption = Sheets(Лист7.name).Range("A1").Value
Label8.Caption = Sheets(Лист8.name).Range("A1").Value
Label9.Caption = Sheets(Лист9.name).Range("A1").Value
Label10.Caption = Sheets(Лист10.name).Range("A1").Value
Label11.Caption = Sheets(Лист11.name).Range("A1").Value
Label12.Caption = Sheets(Лист12.name).Range("A1").Value
Label13.Caption = Sheets(Лист13.name).Range("A1").Value
Label14.Caption = Sheets(Лист14.name).Range("A1").Value
Label15.Caption = Sheets(Лист15.name).Range("A1").Value
Label16.Caption = Sheets(Лист16.name).Range("A1").Value
Label17.Caption = Sheets(Лист17.name).Range("A1").Value
Label18.Caption = Sheets(Лист18.name).Range("A1").Value
Label19.Caption = Sheets(Лист19.name).Range("A1").Value
Label20.Caption = Sheets(Лист20.name).Range("A1").Value
Label21.Caption = Sheets(Лист21.name).Range("A1").Value
Label22.Caption = Sheets(Лист22.name).Range("A1").Value
 
'Контрагент
Label23.Caption = Sheets(Лист31.name).Range("f2").Text
Label24.Caption = Sheets(Лист31.name).Range("f3").Text
Label25.Caption = Sheets(Лист31.name).Range("f4").Text
Label26.Caption = Sheets(Лист31.name).Range("f5").Text
Label27.Caption = Sheets(Лист31.name).Range("f6").Text
Label28.Caption = Sheets(Лист31.name).Range("f7").Text
Label29.Caption = Sheets(Лист31.name).Range("f8").Text
Label30.Caption = Sheets(Лист31.name).Range("f9").Text
Label31.Caption = Sheets(Лист31.name).Range("f10").Text
Label32.Caption = Sheets(Лист31.name).Range("f11").Text
Label33.Caption = Sheets(Лист31.name).Range("f12").Text
Label34.Caption = Sheets(Лист31.name).Range("f13").Text
Label35.Caption = Sheets(Лист31.name).Range("f14").Text
Label36.Caption = Sheets(Лист31.name).Range("f15").Text
Label37.Caption = Sheets(Лист31.name).Range("f16").Text
Label38.Caption = Sheets(Лист31.name).Range("f17").Text
Label39.Caption = Sheets(Лист31.name).Range("f18").Text
Label40.Caption = Sheets(Лист31.name).Range("f19").Text
Label41.Caption = Sheets(Лист31.name).Range("f20").Text
Label42.Caption = Sheets(Лист31.name).Range("f21").Text
Label43.Caption = Sheets(Лист31.name).Range("f22").Text
Label44.Caption = Sheets(Лист31.name).Range("f23").Text
 
 
' Сумма
Label46.Caption = Sheets(Лист31.name).Range("g2").Text
Label47.Caption = Sheets(Лист31.name).Range("g3").Text
Label48.Caption = Sheets(Лист31.name).Range("g4").Text
Label49.Caption = Sheets(Лист31.name).Range("g5").Text
Label50.Caption = Sheets(Лист31.name).Range("g6").Text
Label51.Caption = Sheets(Лист31.name).Range("g7").Text
Label52.Caption = Sheets(Лист31.name).Range("g8").Text
Label53.Caption = Sheets(Лист31.name).Range("g9").Text
Label54.Caption = Sheets(Лист31.name).Range("g10").Text
Label55.Caption = Sheets(Лист31.name).Range("g11").Text
Label56.Caption = Sheets(Лист31.name).Range("g12").Text
Label57.Caption = Sheets(Лист31.name).Range("g13").Text
Label45.Caption = Sheets(Лист31.name).Range("g14").Text
Label58.Caption = Sheets(Лист31.name).Range("g15").Text
Label59.Caption = Sheets(Лист31.name).Range("g16").Text
Label60.Caption = Sheets(Лист31.name).Range("g17").Text
Label61.Caption = Sheets(Лист31.name).Range("g18").Text
Label62.Caption = Sheets(Лист31.name).Range("g19").Text
Label63.Caption = Sheets(Лист31.name).Range("g20").Text
Label64.Caption = Sheets(Лист31.name).Range("g21").Text
Label65.Caption = Sheets(Лист31.name).Range("g22").Text
Label66.Caption = Sheets(Лист31.name).Range("g23").Text
 
' Дата оплаты
Label97.Caption = Sheets(Лист31.name).Range("h2").Text
Label98.Caption = Sheets(Лист31.name).Range("h3").Text
Label99.Caption = Sheets(Лист31.name).Range("h4").Text
Label100.Caption = Sheets(Лист31.name).Range("h5").Text
Label101.Caption = Sheets(Лист31.name).Range("h6").Text
Label102.Caption = Sheets(Лист31.name).Range("h7").Text
Label103.Caption = Sheets(Лист31.name).Range("h8").Text
Label104.Caption = Sheets(Лист31.name).Range("h9").Text
Label105.Caption = Sheets(Лист31.name).Range("h10").Text
Label106.Caption = Sheets(Лист31.name).Range("h11").Text
Label107.Caption = Sheets(Лист31.name).Range("h12").Text
Label108.Caption = Sheets(Лист31.name).Range("h13").Text
Label109.Caption = Sheets(Лист31.name).Range("h14").Text
Label110.Caption = Sheets(Лист31.name).Range("h15").Text
Label111.Caption = Sheets(Лист31.name).Range("h16").Text
Label112.Caption = Sheets(Лист31.name).Range("h17").Text
Label113.Caption = Sheets(Лист31.name).Range("h18").Text
Label114.Caption = Sheets(Лист31.name).Range("h19").Text
Label115.Caption = Sheets(Лист31.name).Range("h20").Text
Label116.Caption = Sheets(Лист31.name).Range("h21").Text
Label117.Caption = Sheets(Лист31.name).Range("h22").Text
Label118.Caption = Sheets(Лист31.name).Range("h23").Text
 
 
End Sub

passedbyz · 22.07.2020, 12:24

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

Гигантский

? Вы мало видели гигантских кодов!
А не оптимизированный? Так вам же не нужна оптимизация, советов слышать не хотите же?

@Burk · 22.07.2020, 12:37

faust21, ну начинаем всё сначала. Вы должны понимать, что поясняете не себе, а людям, несвязанным с важей задачей. И ваш полный код пока и не нужен, я всё-равно его изучать не буду. Лучше бы было прислать файл. До этого я понимал так, что ваши лэблы находятся на некой форме и есть связь между ней и ячейками листа.

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

Конечно объясню:
по клику лэйблов в строке на дату, контрагента, сумму, и

А из этой фразы можно понять так, что объекты расположены непосредственно на листе. Просветите, а то вы своими пояснениями только всё запутали (по моему мнению). Всё-таки файл лучше прислать.

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

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

А из этой фразы можно понять так, что объекты расположены непосредственно на листе.

Постараюсь выразиться точнее: по клику на любой из лейблов на дату, контрагента, сумму, и дата оплаты РАСПОЛОЖЕННЫХ в строку (по горизонтали, друг за другом) на Userform.

К сожалению, прислать файл я не смогу, слишком много связанных макросов и ячеек по всей книге, чтобы скинуть ее в рабочем состоянии.
Приложу вам Userform, если это как-то поможет.

@Burk · 22.07.2020, 13:09

всё-таки форма, хотелось бы её видеть. С Class Module попозже напишу.

Добавлено через 17 минут
при экспорте формы создаются два файла с расширениями frm и frx вы прислали только frm, поэтому вашу форму посмотреть не могу.

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

Burk, О, точно)

@faust21 · 22.07.2020, 13:24 **[ТС]**

Burk, Попробовал сам открыть и не вышло, переделал

@Burk · 22.07.2020, 13:39

Для примера, все ваши присвоения для лэблов можно сделать в цикле для уменьшения размера проги.
For i=1 to 22: Controls("Label" & i).Caption = Sheets("Лист" & i).Range("A1").Value: next
For i = 23 to 44: Controls("Label" & i).Caption =Лист31.Range("f" & i-21).Text: next
и тому подобное

@faust21 · 22.07.2020, 13:58 **[ТС]**

Burk, Пробую и не завелось(

@Burk · 22.07.2020, 14:36

faust21, уважаемый, вы думаете, что я не в состоянии создать пустую форму, которую вы мне прислали? С этого начинают студентов учить. Мне такие глюки больше не присылайте, ладно? И так приблизительно ясны ваши проблемы. Беру тайм-аут.

Добавлено через 12 минут
faust21, значит какие-то листы у вас имеют дргое название, не ЛистNN. Если они у вас идут подряд, то обращайтесь по номеру Shetts(I). Может там перед Controls надо поставить Userform1. И пришлите файл, это будет проще, чем по поводу каждого оператора переписываться. Когда выкатывается окно об ошибке нажимайте на Debug и когда вы будете наводить мышку на переменную будет светиться её значение и можно понять в чем дело. Шлите файл, иначе разговор будет длинный и мне это может надоесть. Или ищите делайте сами. Я вам накидал схему уменьшения кода. Можете уточнить детали самостоятельно.

@Narimanych · 22.07.2020, 14:36

faust21,

passedbyz, правду говорит...

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

В листбоксе, кстати, может быть несколько столбцов

Почитатйте... Как разберетесь- меньше геморра и кода...

Непонятно, зачем "рисовать" таблицы на форме, когда есть лист в экселе?

Не по теме:

С каждым днем все больше удивляюсь...

@faust21 · 22.07.2020, 16:15 **[ТС]**

Narimanych, Может я не до конца понимаю, что мне предлагают, но то что я понял мне не нравится. Хочу на отельной форме. Да, получается таблица в таблице, но мне так нравится.
Попробую еще раз разобраться. Спасибо

Burk, Спасибо за помощь. Решить вопрос с той ошибкой мне удалось. Присвоения лейблов успешно произведено. Застрял на том, что не понимаю как должен выглядеть перебор label?_click. Подскажете?

@Burk · 22.07.2020, 19:15

faust21, конечно помогу с кликом, я же обещал, не будет времени сегодня, пришлю завтра. У меня тоже есть подобный проект где-то на 60 полей и я тоже эти поля вывел на форму, тем более, что некоторые поля заполняются через свою форму запуском макроса через CommandButton. Удобнее мышкой вставать на нужное поле, когда у тебя всё перед глазами в форме, чем двигать лист влево-вправо, рискуя потерять нужную строку, если не все поля заполняются у человека (у меня строка это один человек) и с учетом того, что заполняет таблицу оператор. А с такой формой заполнения операторы справляются легко.

Добавлено через 2 часа 29 минут
faust21, стоп! Только сейчас обратил внимание, что ваши клики ничего не делают кроме как копируют ячейку с одного листа на другой!! И зачем тогда эти лэблы? Я привык к тому, что что-либо меняешь в форме и это изменение должно занестись на лист. Можно просто через проверку изменения значения на одном листе копировать это значение на другой через Worksheet_Change. Либо вместо ваших лэблов создать на форме текстбоксы занести туда значения из листа, а потом, в случае изменения какого-то значения, изменить его на другом листе. Только так.

@pashulka · 22.07.2020, 19:25

Burk, Там вообще детективная история

там есть копирование, но нет вставки скопированных данных.

Visual Basic
1
2
3
4
5
Dim cell As Range
    Set cell = ActiveSheet.Range("A1")
    cell.Copy
    Z = CDate(cell)
      Sheets(Лист31.name).Range("h6").Value = Z

По сути там есть присвоение одной ячейки - значения другой, т.е.

Visual Basic
1
Sheets(Лист31.name).Range("h6") = CDate(Range("A1")) 'Если в ячейке A1 дата, то CDate не нужна

А вот зачем там копирование, это вопрос... причём изначально его не было, потом, вдруг появилось.

@Burk · 22.07.2020, 19:33

pashulka, конечно ку-ку и я на своем опыте проскочил мимо этой ерунды. То что там скопировано, может пригодиться в другой жизни. Зато очень хитрое присвоение одной ячейке другой получилось. Да, с этими ребятами ухо надо держать востро, каюсь.

@Narimanych · 22.07.2020, 19:33

pashulka,

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

Может я не до конца понимаю, что мне предлагают, но то что я понял мне не нравится.

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

Хочу на отельной форме. Да, получается таблица в таблице, но мне так нравится.

Свободный художник .

P.S. Думаю , если будет приведено конкретное техническое задание , всех этих извращений можно было бы давно избежать....

@pashulka · 22.07.2020, 19:43

Burk, Я там всё облазил... нигде не нашёл использование данных из буфера обмена. Может автор, после работы с формой их использует... в общем, зачем нужно копирование, пока тайна.

@Burk · 22.07.2020, 19:56

pashulka, думаю, что это, как обычно, недоработка преподавателя, а копирование там нафиг не нужно.

@faust21 · 23.07.2020, 06:42 **[ТС]**

Друзья Burk, pashulka, Narimanych, , я очень рад, что мой пост стал таким обсуждаемым и собрал в себе таких опытных людей.

Нужно было сразу оговорить, что образования в области информатики/программирования у меня нет. Никто ничему меня не обучал (семестр курса информатики 10 лет назад не в счёт). Всем этим я занимаюсь потому что МНЕ это интересно. Занимаюсь я этим методом тыка/гугла/ и задавая вопрос на профильных сайтах. По возможности я разбираюсь в коде что к чему, адаптирую его под себя. Дважды один вопрос я не задаю, тк я теперь ЗНАЮ САМ как и что делать.

Что касается cell.copy вы абсолютно правы, она там нафиг не нужна. Этот код был скопирован у меня из другого места, поменяно несколько ссылок и оставлено так как есть. Заметил я лишнее, когда создавал пост и дабы не позориться удалил его. В процессе пока я пытался С Вашей помощью как-то оптимизировать свой код, я там столько на колбасил, что пришлось выйти без сохранения, чтобы отправить форму Burk,

Что касается самой формы. Да, то что там делается нужно только мне и только. По сути эта форма является упорядоченным отражением другого листа, за исключением того, что по клику можно отметить дату оплаты. Повторюсь, мое видение может быть сколько угодно корявым, не правильным и нелогичным, но в силу своих небольших знаний в области VBA я смог решить задачу именно так.

Весь код работает, даже та форма, что я скинул уже доработана, убрано куча лишних лейблов, созданных по ошибке, добавлен новый код и преведено все в эстетический порядок. Мне нужна была помощь лишь в оптимизации... Все ещё надеюсь что вы мне подскажете, но параллельно гуглю и пытаюсь вникнуть в модуль классов.
Спасибо за вообще внимание))

@Kubuntovod · 23.07.2020, 07:57

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

Застрял на том, что не понимаю как должен выглядеть перебор label?_click. Подскажете?

Когда с классами разберётесь, тогда этот вопрос будет неактуален. Если Ваши контролы будут создаваться на основе класса, то в этом классе и прописывается процедура кликанья.

Новые блоги и статьи Все статьи Все блоги /
Транскрипция 55-минутного видео через Whisper: WhisperDesktop облажался, спас Google Colab[ anaschu 01.06.2026 Понадобилось получить текст из свежезагруженного видео на YouTube. Казалось бы, задача на пять минут. Заняла полтора часа. Делюсь опытом — может кому пригодится последовательность решений. . . .	21 мат мед. Планы на развитие модели здравоСохранения anaschu 01.06.2026 AnyLogic: план развития симуляционной модели рабочего коллектива — динамический абсентеизм, реальные данные, три сценария сравнения Продолжаю серию постов о дискретно-событийной модели рабочего. . .	20. Мат мед. Абсентеизм как отдельный тип простоя anaschu 29.05.2026 Апдейт модели: исправленные баги, абсентеизм и новые механизмы Продолжаю развивать ранее описанную модель рабочего коллектива на AnyLogic. За последние несколько дней был проведён серьёзный. . .	19. здоровье, усталость и психотип работника влияют на производительность предприятия, и наоборот, производительность на здоровье, усталось и психотип anaschu 28.05.2026 Дискретно-событийная модель рабочего коллектива на AnyLogic: здоровье, выгорание, психотипы и микростимуляция Привет, коллеги. Хочу поделиться итогами нескольких недель работы над симуляционной. . .
"Прокси" для последовательного порта Eddy_Em 28.05.2026 Эту штуку написал я достаточно давно. Но сейчас вот понадобилось настроить датчик грозы, но при этом не отключать его от "метеодемона". Соответственно, надо запустить этот "прокси": метеодемон будет. . .	Рефакторинг программы уравнивания. Massaraksh7 26.05.2026 Пример по предыдущей записи в блоге. Но, надо заметить, что, во-первых, там оптимизация не только математики, но и работы с базой данных, и с графами, а во-вторых, это ещё не всё.	Использование TThread в Lazarus для математических вычислений. Massaraksh7 25.05.2026 Производя рефакторинг своих программ на предмет ускорения их работы, обратил внимание на такой аспект, как сокращение времени матвычислений. Дело в том, что приходится работать с большими матрицами. . .	Модель здравосохранения 18. Чем здоровее работник, тем быстрее выгорает anaschu 24.05.2026 Имитационная модель корпоративного здравоохранения: что показывает математика Сегодня в модели рабочего коллектива на AnyLogic появились три новые механики — выгорание через накопленную усталость,. . .

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.07.2020, 13:09
	всё-таки форма, хотелось бы её видеть. С Class Module попозже напишу. Добавлено через 17 минут при экспорте формы создаются два файла с расширениями frm и frx вы прислали только frm, поэтому вашу форму посмотреть не могу. 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.07.2020, 13:39
	Для примера, все ваши присвоения для лэблов можно сделать в цикле для уменьшения размера проги. For i=1 to 22: Controls("Label" & i).Caption = Sheets("Лист" & i).Range("A1").Value: next For i = 23 to 44: Controls("Label" & i).Caption =Лист31.Range("f" & i-21).Text: next и тому подобное 1

@faust21 1 / 1 / 0 Регистрация: 21.01.2020 Сообщений: 184
	22.07.2020, 13:58 [ТС]
	Burk, Пробую и не завелось( Миниатюры 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.07.2020, 14:36
	faust21, уважаемый, вы думаете, что я не в состоянии создать пустую форму, которую вы мне прислали? С этого начинают студентов учить. Мне такие глюки больше не присылайте, ладно? И так приблизительно ясны ваши проблемы. Беру тайм-аут. Добавлено через 12 минут faust21, значит какие-то листы у вас имеют дргое название, не ЛистNN. Если они у вас идут подряд, то обращайтесь по номеру Shetts(I). Может там перед Controls надо поставить Userform1. И пришлите файл, это будет проще, чем по поводу каждого оператора переписываться. Когда выкатывается окно об ошибке нажимайте на Debug и когда вы будете наводить мышку на переменную будет светиться её значение и можно понять в чем дело. Шлите файл, иначе разговор будет длинный и мне это может надоесть. Или ищите делайте сами. Я вам накидал схему уменьшения кода. Можете уточнить детали самостоятельно. 0

@faust21 1 / 1 / 0 Регистрация: 21.01.2020 Сообщений: 184
	22.07.2020, 16:15 [ТС]
	Narimanych, Может я не до конца понимаю, что мне предлагают, но то что я понял мне не нравится. Хочу на отельной форме. Да, получается таблица в таблице, но мне так нравится. Попробую еще раз разобраться. Спасибо Burk, Спасибо за помощь. Решить вопрос с той ошибкой мне удалось. Присвоения лейблов успешно произведено. Застрял на том, что не понимаю как должен выглядеть перебор label?_click. Подскажете? 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.07.2020, 19:15
	faust21, конечно помогу с кликом, я же обещал, не будет времени сегодня, пришлю завтра. У меня тоже есть подобный проект где-то на 60 полей и я тоже эти поля вывел на форму, тем более, что некоторые поля заполняются через свою форму запуском макроса через CommandButton. Удобнее мышкой вставать на нужное поле, когда у тебя всё перед глазами в форме, чем двигать лист влево-вправо, рискуя потерять нужную строку, если не все поля заполняются у человека (у меня строка это один человек) и с учетом того, что заполняет таблицу оператор. А с такой формой заполнения операторы справляются легко. Добавлено через 2 часа 29 минут faust21, стоп! Только сейчас обратил внимание, что ваши клики ничего не делают кроме как копируют ячейку с одного листа на другой!! И зачем тогда эти лэблы? Я привык к тому, что что-либо меняешь в форме и это изменение должно занестись на лист. Можно просто через проверку изменения значения на одном листе копировать это значение на другой через Worksheet_Change. Либо вместо ваших лэблов создать на форме текстбоксы занести туда значения из листа, а потом, в случае изменения какого-то значения, изменить его на другом листе. Только так. 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.07.2020, 19:33
	pashulka, конечно ку-ку и я на своем опыте проскочил мимо этой ерунды. То что там скопировано, может пригодиться в другой жизни. Зато очень хитрое присвоение одной ячейке другой получилось. Да, с этими ребятами ухо надо держать востро, каюсь. 0

@pashulka 4139 / 2243 / 940 Регистрация: 01.12.2010 Сообщений: 4,624
	22.07.2020, 19:43
	Burk, Я там всё облазил... нигде не нашёл использование данных из буфера обмена. Может автор, после работы с формой их использует... в общем, зачем нужно копирование, пока тайна. 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.07.2020, 19:56
	pashulka, думаю, что это, как обычно, недоработка преподавателя, а копирование там нафиг не нужно. 0

@faust21 1 / 1 / 0 Регистрация: 21.01.2020 Сообщений: 184
	23.07.2020, 06:42 [ТС]
	Друзья Burk, pashulka, Narimanych, , я очень рад, что мой пост стал таким обсуждаемым и собрал в себе таких опытных людей. Нужно было сразу оговорить, что образования в области информатики/программирования у меня нет. Никто ничему меня не обучал (семестр курса информатики 10 лет назад не в счёт). Всем этим я занимаюсь потому что МНЕ это интересно. Занимаюсь я этим методом тыка/гугла/ и задавая вопрос на профильных сайтах. По возможности я разбираюсь в коде что к чему, адаптирую его под себя. Дважды один вопрос я не задаю, тк я теперь ЗНАЮ САМ как и что делать. Что касается cell.copy вы абсолютно правы, она там нафиг не нужна. Этот код был скопирован у меня из другого места, поменяно несколько ссылок и оставлено так как есть. Заметил я лишнее, когда создавал пост и дабы не позориться удалил его. В процессе пока я пытался С Вашей помощью как-то оптимизировать свой код, я там столько на колбасил, что пришлось выйти без сохранения, чтобы отправить форму Burk, Что касается самой формы. Да, то что там делается нужно только мне и только. По сути эта форма является упорядоченным отражением другого листа, за исключением того, что по клику можно отметить дату оплаты. Повторюсь, мое видение может быть сколько угодно корявым, не правильным и нелогичным, но в силу своих небольших знаний в области VBA я смог решить задачу именно так. Весь код работает, даже та форма, что я скинул уже доработана, убрано куча лишних лейблов, созданных по ошибке, добавлен новый код и преведено все в эстетический порядок. Мне нужна была помощь лишь в оптимизации... Все ещё надеюсь что вы мне подскажете, но параллельно гуглю и пытаюсь вникнуть в модуль классов. Спасибо за вообще внимание)) 0