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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 21.01.2019, 16:18   #1
Елена195
Пользователь
 
Регистрация: 21.01.2019
Сообщений: 27
Вопрос Макрос с циклом по столбцам

Добрый день!

Подскажите пожалуйста как можно оптимизировать макрос?
В файле есть таблица, по месяцу, необходимо ее преобразовать в список.
Я написала макрос, но он как я понимаю достаточно долгий и не оптимальный.
Что-то мне подсказывает, что это можно сделать быстрее и короче через цикл, но никак не могу понять как..
Это мое первое знакомство с макросами.

Подскажите пожалуйста, как можно преобразовать таблицу в список, с помощью цикла.

Буду очень благодарна)
Вложения
Тип файла: xlsx Списочек.xlsx (57.0 Кб, 18 просмотров)
Елена195 вне форума Ответить с цитированием
Старый 21.01.2019, 16:55   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Option Explicit

Private Sub ScreensOFF()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual 'Это поможет при наличии завязанных на редактируемые данные формул
    Application.EnableCancelKey = xlDisabled ' Fix for Code execution has been interrupted
End Sub

Private Sub ScreensON()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic 'Это поможет при наличии завязанных на редактируемые данные формул
End Sub

Sub GoMyWork()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim iLastRow As Integer
    Dim iLastCol As Integer
    Dim i, j, r
    Set sh1 = Sheets("Один ролик")
    Set sh2 = Sheets("c"): sh2.range("A2:H5000").ClearContents
    ScreensOFF
    With sh1
        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        r = 2
        For i = 4 To iLastRow
            For j = .Range("CD1").Column To iLastCol
                If .Cells(i, j) <> "" Then
                    r = r + 1
                    sh2.Cells(r, "A") = .Cells(3, j)
                    sh2.Cells(r, "B") = .Cells(i, "B")
                    sh2.Cells(r, "C") = .Cells(i, "C")
                    sh2.Cells(r, "D") = .Cells(i, "D")
                    sh2.Cells(r, "E") = .Cells(i, "E")
                    sh2.Cells(r, "F") = .Cells(i, "F")
                    sh2.Cells(r, "G") = .Cells(i, "G")
                    sh2.Cells(r, "H") = .Cells(i, j)
                End If
            Next j
        Next i
    End With
    ScreensON
    Set sh1 = Nothing
    Set sh2 = Nothing
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 22.01.2019, 10:59   #3
Елена195
Пользователь
 
Регистрация: 21.01.2019
Сообщений: 27
Радость

Александр,

Большое спасибо!
Макрос работает просто прекрасно!

Пытаюсь понять как работает этот код. мои вопросы зеленым:
Код:
Option Explicit

Private Sub ScreensOFF() 'Это что бы было не видно как вставляются ячейки. верно? это ускоряет макрос?
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual 'Это что то вроде вставить значения?
    Application.EnableCancelKey = xlDisabled ' немного не поняла, что делает эта строка.
End Sub

Private Sub ScreensON()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic 'Зачем это прописывать второй раз?
End Sub

Sub GoMyWork()
    Dim sh1 As Worksheet 
    Dim sh2 As Worksheet
    Dim iLastRow As Integer
    Dim iLastCol As Integer
    Dim i, j, r
    Set sh1 = Sheets("Один ролик")
    Set sh2 = Sheets("c"): sh2.range("A2:H5000").ClearContents 'Как я понимаю это очищает диапазон A2:H5000 от значений, а первая строка остается для заголовков, верно?
    ScreensOFF
    With sh1 
        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 'Тут задается что по столбцам нужно двигаться вверх, верно?
        iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column 'Тут задается что по строкам нужно двигаться влево, верно, а с третьей потому что таблица интересующая нас начинается с третьей строки?
        r = 2
        For i = 4 To iLastRow
            For j = .Range("CD1").Column To iLastCol
                If .Cells(i, j) <> "" Then
                    r = r + 1
                    sh2.Cells(r, "A") = .Cells(3, j)
                    sh2.Cells(r, "B") = .Cells(i, "B")
                    sh2.Cells(r, "C") = .Cells(i, "C")
                    sh2.Cells(r, "D") = .Cells(i, "D")
                    sh2.Cells(r, "E") = .Cells(i, "E")
                    sh2.Cells(r, "F") = .Cells(i, "F")
                    sh2.Cells(r, "G") = .Cells(i, "G")
                    sh2.Cells(r, "H") = .Cells(i, j)
                End If
            Next j
        Next i
    End With 'Тут заканчивается работа с первым числом, и если мы хотим добавить так же данные из второго листа ( с такой же структурой), нам нужно:
Set sh3 = Sheets("Второй лист")
With sh3
        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        r = Cells(Rows.Count, 1).End(xlUp).Row
        For i = 4 To iLastRow
            For j = .Range("CD1").Column To iLastCol
                If .Cells(i, j) <> "" Then
                    r = r + 1
                    sh2.Cells(r, "A") = .Cells(3, j)
                    sh2.Cells(r, "B") = .Cells(i, "C")
                    sh2.Cells(r, "C") = .Cells(i, "D")
                    sh2.Cells(r, "D") = .Cells(i, "E")
                    sh2.Cells(r, "E") = .Cells(i, "F")
                    sh2.Cells(r, "F") = .Cells(i, "G")
                    sh2.Cells(r, "G") = .Cells(i, "H")
                    sh2.Cells(r, "H") = .Cells(i, j)
                End If
            Next j
        Next i
    End With  
    ScreensON
    Set sh1 = Nothing
    Set sh2 = Nothing
Set sh3 = Nothing ' Подскажите пожалуйста, зачем нужна эта строка? Это так бы закрытие действия если по заданным условиям не осталось данных?

End Sub
Буду благодарна за ответы)

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

Код:
Private Sub ScreensOFF() 
' http://www.codernotes.ru/articles/vba/uskorit-vypolnenie-vba.html
End Sub

Private Sub ScreensON()
' http://www.codernotes.ru/articles/vba/uskorit-vypolnenie-vba.html
End Sub

Sub GoMyWork()
    Set sh2 = Sheets("c"): sh2.range("A2:H5000").ClearContents ' очистить диапазон А2:Н5000 листа С
    
	iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 'Найти номер последней строки с данными на листе "Один ролик". Искать по столбце В
    iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column 'Найти номер последнего столбца с данными в 3 строке на лсите "Один ролик"
        
    End With 'Тут заканчивается работа с листом "Один ролик"
	
	'если мы хотим добавить так же данные из второго листа ( с такой же структурой), нам нужно:
	set sh1 = Sheets("Второй лист")
	With sh1 
        .....
    End With 
    
	Set sh3 = Nothing ' Не нужна
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 22.01.2019, 16:04   #5
Елена195
Пользователь
 
Регистрация: 21.01.2019
Сообщений: 27
По умолчанию

Александр, то есть мы как бы переименовываем переменную?
Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
'если мы хотим добавить так же данные из второго листа ( с такой же структурой), нам нужно:
set sh1 = Sheets("Второй лист")
With sh1
.....
Елена195 вне форума Ответить с цитированием
Старый 22.01.2019, 16:09   #6
p51x
Старожил
 
Регистрация: 15.02.2010
Сообщений: 15,695
По умолчанию

Что вы подразумеваете под переименованием? Если мы пишем а = 1. Мы единицу переименовываем?
p51x вне форума Ответить с цитированием
Старый 22.01.2019, 16:10   #7
Елена195
Пользователь
 
Регистрация: 21.01.2019
Сообщений: 27
По умолчанию

Нет,
если а=1, а потом а=2 то мы а переименовали из 1 в 2
Елена195 вне форума Ответить с цитированием
Старый 22.01.2019, 16:10   #8
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Нет, мы делаем переменную Sh1 ссылкой на обект Sheets("Второй лист")

https://docs.microsoft.com/ru-ru/off.../set-statement

Можете вместо sh1 использовать Sheets("Второй лист")
Код:
With sheets("Второй лист")
.....
тогда ненужны и
Код:
set sh1 = sheets("Второй лист") i set sh1 = nothing
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 22.01.2019, 16:14   #9
Елена195
Пользователь
 
Регистрация: 21.01.2019
Сообщений: 27
По умолчанию

Александр,

Спасибо большое.
Теперь вроде все поняла)
Елена195 вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос для Excel с циклом перебора страниц silhouette69 Фриланс 4 26.04.2015 09:28
Сортировка по столбцам. павел павел Microsoft Office Access 28 09.11.2012 20:25
Макрос объединяющий ячейки по столбцам на всю страницу var_fj54j Microsoft Office Excel 3 12.06.2012 15:55
Макрос с циклом dsmtnkn Microsoft Office Excel 5 15.08.2011 09:40
как остановить макрос с бесконечным циклом zander Microsoft Office Excel 4 09.09.2010 20:53