Доброго дня товарищи, я новичок в vba, делаю почти все методом проб и ошибок, наваял код, но он какой-то прямо громоздкий получается, помогите упростить макрос:
Код |
---|
Sub rrrr()
For con1 = 3 To 50
Set dtime = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con1, 2)
Set dname = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con1, 4)
Set ddat = ThisWorkbook.Worksheets("Эфирная сетка").Cells(1, 2)
gh = (ThisWorkbook.Worksheets("Лист4").UsedRange.Row - 1 + ThisWorkbook.Worksheets("Лист4").UsedRange.Rows.Count) + 1
Set wdat = ThisWorkbook.Worksheets("Лист4").Cells(gh, 1)
Set wtime = ThisWorkbook.Worksheets("Лист4").Cells(gh, 2)
Set wname = ThisWorkbook.Worksheets("Лист4").Cells(gh, 3)
Set ganr = ThisWorkbook.Worksheets("Лист4").Cells(gh, 4)
Set wvoz = ThisWorkbook.Worksheets("Лист4").Cells(gh, 5)
Set wanot = ThisWorkbook.Worksheets("Лист4").Cells(gh, 6)
If dtime.Value > 0 Then
wtime.Value = dtime
wname.Value = dname
wdat.Value = ddat.Value
i = dname
j = Application.Match(i, [Название], 0)
wvoz.Value = Application.Index([ОписаниеПрограмм], j, 2)
ganr.Value = Application.Index([ОписаниеПрограмм], j, 3)
wanot.Value = Application.Index([ОписаниеПрограмм], j, 4)
End If
Next con1
For con2 = 3 To 50
Set dtime = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con2, 8)
Set dname = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con2, 10)
Set ddat = ThisWorkbook.Worksheets("Эфирная сетка").Cells(1, 8)
gh = (ThisWorkbook.Worksheets("Лист4").UsedRange.Row - 1 + ThisWorkbook.Worksheets("Лист4").UsedRange.Rows.Count) + 1
Set wdat = ThisWorkbook.Worksheets("Лист4").Cells(gh, 1)
Set wtime = ThisWorkbook.Worksheets("Лист4").Cells(gh, 2)
Set wname = ThisWorkbook.Worksheets("Лист4").Cells(gh, 3)
Set ganr = ThisWorkbook.Worksheets("Лист4").Cells(gh, 4)
Set wvoz = ThisWorkbook.Worksheets("Лист4").Cells(gh, 5)
Set wanot = ThisWorkbook.Worksheets("Лист4").Cells(gh, 6)
If dtime.Value > 0 Then
wtime.Value = dtime
wname.Value = dname
wdat.Value = ddat.Value
i = dname
j = Application.Match(i, [Название], 0)
wvoz.Value = Application.Index([ОписаниеПрограмм], j, 2)
ganr.Value = Application.Index([ОписаниеПрограмм], j, 3)
wanot.Value = Application.Index([ОписаниеПрограмм], j, 4)
End If
Next con2
End Sub
|
Дело в том что таких циклов у меня будет 7, и во всех циклах вот этот код повторяется:
Код |
---|
gh = (ThisWorkbook.Worksheets("Лист4").UsedRange.Row - 1 + ThisWorkbook.Worksheets("Лист4").UsedRange.Rows.Count) + 1
Set wdat = ThisWorkbook.Worksheets("Лист4").Cells(gh, 1)
Set wtime = ThisWorkbook.Worksheets("Лист4").Cells(gh, 2)
Set wname = ThisWorkbook.Worksheets("Лист4").Cells(gh, 3)
Set ganr = ThisWorkbook.Worksheets("Лист4").Cells(gh, 4)
Set wvoz = ThisWorkbook.Worksheets("Лист4").Cells(gh, 5)
Set wanot = ThisWorkbook.Worksheets("Лист4").Cells(gh, 6)
If dtime.Value > 0 Then
wtime.Value = dtime
wname.Value = dname
wdat.Value = ddat.Value
i = dname
j = Application.Match(i, [Название], 0)
wvoz.Value = Application.Index([ОписаниеПрограмм], j, 2)
ganr.Value = Application.Index([ОписаниеПрограмм], j, 3)
wanot.Value = Application.Index([ОписаниеПрограмм], j, 4) |
Спасибо