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

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

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 19.07.2016, 11:24   #1
Ogeris
Пользователь
 
Регистрация: 26.10.2010
Сообщений: 87
По умолчанию Упростить процедуру, меняются только наименование листа и столбца

Добрый день!

Есть процедура, она повторяется снова и снова. Меняется в ней только наименование листов (по порядку от "01" до "25") и наименование столбцов (их тоже 25, они именуются через один: A,C,E,и т.д.).

Можно ли как-то компактно записать эту процедуру, не переписывая код 25 раз, руками меняя названия листов и столбцов?

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

Спасибо!

Код:
    Windows("База данных.xls").Activate
  Sheets("01").Activate
    Range("BK3").Select
    ActiveCell.FormulaR1C1 ="=VLOOKUP(RC[-62],'[План продаж.xlsm]01'!R6C1:R500C32,2,0)-RC[-61]"
    Range("BK3").Copy
    Range("BK4:BK500").Select
    ActiveSheet.Paste
    Range("BK3").Select
    ActiveSheet.Range("$BK$2:$CO$500").AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
Range("A3:B" & Cells(Rows.Count, 1).End(xlUp).Row).Select
Selection.Copy
    Windows("План продаж.xlsm").Activate
     Sheets("Результаты").Select
Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("База данных.xls").Activate
  Sheets("01").Activate
    ActiveSheet.Range("$BK$2:$CO$500").AutoFilter Field:=1
    Range("BK3:BK500").Select
    Selection.ClearContents
    Range("BK3").Select
    
    Windows("План продаж.xlsm").Activate
    Sheets("Результаты").Select
    Range("A3").Select
Ogeris вне форума Ответить с цитированием
Старый 19.07.2016, 15:02   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

1. избавиться от селектов
2. для листов в цикле
Код:
for i = 1 to 25 
Sheets(Format(i, "00")).Activate
3. для столбцов в цикле с кроком 2, использовать Cells вместо Range
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 20.07.2016, 09:28   #3
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
for i = 1 to 25
  with worksheets(i).columns((i-1)*2+1)
    ' здесь Вы на "территории" требуемого столбца требуемого листа
    msgbox worksheetfunction.sum(.cells) ' вот сообщение о сумме всех ячеек названного столбца
  end with
next
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 20.07.2016, 10:51   #4
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Кстати, есть ли возможность без цикла выделить диапазон строк по 2 критериям?

Например вставить на другой лист строки в которых:
а) в столбце В встречается любой текст
или
б) в стобце С встречается текст "Текст"
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 20.07.2016, 13:20   #5
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

а) Columns(2).SpecialCells(xlCellTypeC onstants, xlTextValues).entirerow.copy Вот_сюда
б) находить "Текст" по одному добавлять
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 20.07.2016, 13:48   #6
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
б) находить "Текст" по одному добавлять
за один проход?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 20.07.2016, 14:09   #7
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

да стандартным Range.Find(...)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 21.07.2016, 10:21   #8
Ogeris
Пользователь
 
Регистрация: 26.10.2010
Сообщений: 87
По умолчанию

Спасибо!

Только вот что означает "с кроком 2" ?
Ogeris вне форума Ответить с цитированием
Старый 21.07.2016, 10:31   #9
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от Ogeris Посмотреть сообщение
Спасибо!

Только вот что означает "с кроком 2" ?

проблемы с переводом на русский язык. "с шагом 2"

Код:
For i = 1 to 20 step 2
debug.print i
next
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 21.07.2016, 13:31   #10
Ogeris
Пользователь
 
Регистрация: 26.10.2010
Сообщений: 87
По умолчанию

возможно ли, чтобы обе процедуры не мешали друг другу?

У меня получается, что какой-то один из двух For... "перекрывает" работу другого. В данном случае он переходит с листа "01" на лист "02", но номер столбца не меняет:

Код:
Sub experiment()
  Dim i As Long
   Dim v As Long
  On Error Resume Next
 For v = 1 To 20 Step 2
 For i = 1 To 25
Debug.Print i

    Windows("База данных.xls").Activate
Sheets(Format(i, "00")).Activate
    Range("BK3").FormulaR1C1 = _
        "=VLOOKUP(RC[-62],'[План продаж.xlsm]01'!R6C1:R500C32,2,0)-RC[-61]"
    Range("BK3").Copy
    Range("BK4:BK500").Select
    ActiveSheet.Paste
    Range("BK3").Range("$BK$2:$CO$500").AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
Range("A3:B" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
    Windows("План продаж.xlsm").Activate
    
     Sheets("Результаты").Select
    Cells(3, v).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("База данных.xls").Activate
Sheets(Format(i, "00")).Activate
    ActiveSheet.Range("$BK$2:$CO$500").AutoFilter Field:=1
    Range("BK3:BK500").ClearContents

    
   
  Next
  Next
  On Error GoTo 0
 
End Sub
Ogeris вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание листа по вводным первого листа первого столбца -Rama- Microsoft Office Excel 4 08.06.2012 23:37
Как найти минимум и вывести наименование этого столбца Tolikv Microsoft Office Excel 3 30.12.2011 12:16
Перебор ячеек столбца и формирование нового листа из уникальных записей Ad1r Microsoft Office Excel 3 06.05.2010 09:38
Копирование данных с одного листа на другой по значению первого столбца Lis000iq Microsoft Office Excel 11 07.03.2010 13:34
как упростить код, используя только массивы, циклы, разветвления и указатели? laxe Общие вопросы C/C++ 22 01.09.2009 09:16