Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Excel VBA

Модерирует : ShIvADeSt

ShIvADeSt (23-04-2007 01:59): http://forum.ru-board.com/topic.cgi?forum=33&topic=8273  Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 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

   

RUSmafia



Full Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

 
 
Обсуждаем вопросы только по Excel VBA
(программирование макросов, скриптов, пользовательских функций и т.п.).
Приветствуются ссылки на ресурсы и справочную литературу по теме.
 
Вопросы по работе с MS Excel, не относящиеся к программированию, задаем в теме Excel FAQ

 
Обратите внимание, этот топик для помощи в изучении и использовании VBA. Посему запросы типа "Напишите мне такой-то макрос, я VBA не знаю и знать не хочу" не приветствуются.
Древняя мудрость: "Накорми голодного рыбой и он погибнет, научи его ловить рыбу и ты спасешь его."(R)
 
Информация общего характера:
  • Список соответствия имен функций в английской и русской версиях Excel
  • Описание Microsoft Excel File Format
     
    Рекомендации:
    Если у Вас есть проблема, не решаемая стандартными средствами Excel (об этом можно уточнить здесь) или требующая автоматизации, попробуйте для начала записать макрос самим Excel через меню Сервис (Tools) - Макрос (Macro) - Начать запись (Record New Macro). Подробнее здесь. В большинстве случаев получившийся код (Сервис-Макрос-Макросы-Изменить) Вас не удовлетворит, но подскажет, какие объекты-методы-свойства использовать.  
    Другой Ваш помощник - Просмотр объектов (Object Browser). Ну и встроення помощь (F1), естественно.
     
    Если Вы в тупике, покажите Ваш код (или часть кода) здесь.  Если вылазит ошибка, цитируйте ее полностью. Если код слишком большой, используйте тeг [more].
    Используйте отладчик - Breakpoints (F9), Watches (Shift-F9), Steps (F8 и др.) Сильно облегчает поиск ошибок.

     
    Рекомендуется к прочтению:
  • Первые шаги с Excel VBA
  • Excel VBA: Приёмы программирования
  • WinApi. Лекция из курса "Основы офисного программирования и язык VBA" (для продвинутых)
  • Daily Dose of Excel (eng.) - тематический блог: советы по работе с Excel и прочие материалы
  • Excel Macros & Excel VBA Code Tips, Tricks (eng.) - советы, трюки и уловки
  • Mr. Excel (forum) (eng.) - весьма оживленный форум по Excel&VBA.
     
    Родственные топики:
  • Вопросы по работе с MS Excel - Excel FAQ - часть 1, часть 2
  • Технические проблемы с MS Office 2003 или Office XP.
  • Word VBA все вопросы по Word VBA туда
  • Access все вопросы по программированию в Access туда
  • Книжульки по VBA - книги по программированию с использованием VBA
     
    Конкретные вопросы:
    Форма-заставка
    Как запустить макрос при изменении положения курсора или значения ячейки
  • Пример 1
  • Пример 2
  • Пример 3 (проверка области)
  • Пример 4
  • Пример 5
    Зацикливание в функции Change или SelectionChange
     
    Ранжирование без пробелов (макрос включает функции сортировки массива и удаления дубликатов, работает и в Excel 2007)
  • под Office 97
     
    Добавление в главное меню своего пункта, ассоциированного с макросом
    Создание ярлыка на рабочем столе
    Снятие защиты листа при забытом пароле
    Смена раскладки клавиатуры
    Скролл формы колесом прокрутки мыши
    Оптимизация кода по быстродействию использованием массивов

  • Всего записей: 556 | Зарегистр. 31-07-2002 | Отправлено: 21:40 14-10-2004 | Исправлено: lucky_Luk, 20:44 13-04-2007
    Od_UA

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    В диапазоне А:К найти ячейки с одинаковыми данными и выделить их др.цветом!? (1 гость)  
     
    Заранее благодарен!

    Всего записей: 1 | Зарегистр. 14-03-2007 | Отправлено: 12:48 14-03-2007
    Vitus_Bering



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Возможно ли программно или с помощью макроса создать сводную таблицу в Excel-97?

    Всего записей: 936 | Зарегистр. 30-09-2005 | Отправлено: 15:26 14-03-2007
    AndVGri

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Od_UA
     
    На не более 55 одинаковых групп, несколько медленное решение, но..
     
    Public Sub EqualColorization()
        Dim pAll As New Scripting.Dictionary
        Dim pGroup As New Scripting.Dictionary
        Dim rowLast As Long, colLast As Long
        Dim iRow As Long, iCol As Long, vEntry As String
        Dim idColor As Long, firstEntry As Excel.Range
         
        rowLast = Cells(1&, 1&).End(xlDown).Row
        colLast = Cells(1&, 1&).End(xlToRight).Column
        idColor = 57&
         
        For iCol = 1& To colLast
            For iRow = 1& To rowLast
                vEntry = CStr(Cells(iRow, iCol).Value)
                If pAll.Exists(vEntry) Then
                    If pGroup.Exists(vEntry) Then
                        Cells(iRow, iCol).Interior.ColorIndex = CLng(pGroup.Item(vEntry))
                    Else
                        idColor = idColor - 1&
                        If idColor < 2& Then idColor = 56&
                        pGroup.Add vEntry, idColor
                        Cells(iRow, iCol).Interior.ColorIndex = idColor
                        Set firstEntry = pAll.Item(vEntry)
                        firstEntry.Interior.ColorIndex = idColor
                    End If
                Else
                    pAll.Add vEntry, Cells(iRow, iCol)
                End If
            Next iRow
        Next iCol
    End Sub

    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 16:17 14-03-2007
    AsPAndA

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    у меня такой вопрос => как мне сравнивать значение ячеекдвух файлов?
     
    Например
    for i=1 to 10000(конец Sheeta нужен если что, может как то еще можно , а то я заведомо большое беру )
     for j=1 to 10000 (конец sheeta1 документа Б)
           if cells(i:1).value=cells(j:4).value do вот здесь и есть разные файлы
                  4to to tam
           end if
     next j
    next i
     
    Заранее спасибо!!!
    ------------------------------------------------------------------------------
    Нет я не знаю как мне обратится к другому фаилу(то есть так , как я написал он на одном листе сравнивает а мне надо 2 разных фаила А.xls и Б.xls)
    ну и про размер sheeta хотелось бы узнать, а то лишнего много проверяется(вместо 10000 например переменная KonecA u KonecB , которые бы означали кол-во рабочих строк sheeta )  
     
    Добавлено:
    rowLast = Cells(1&, 1&).End(xlDown).Row  
    ну вот это как я понимаю ответ на мой вопрос о кол-ве строк  
    СПАСИБО!!!

    Всего записей: 7 | Зарегистр. 01-11-2005 | Отправлено: 16:22 14-03-2007
    SERGE_BLIZNUK

    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    AndVGri
    Цитата:
    Dim pAll As New Scripting.Dictionary  
     
    а подскажите, через банальный перебор сверху вниз не быстрее будет?
     
    AsPAndA

    Цитата:
    rowLast = Cells(1&, 1&).End(xlDown).Row  

    это вернёт максимальную Строчку только для первого столбца...
     
    и вообще лучше такой код:
    'Определить число используемых рядов:  
    nr = ActiveSheet.UsedRange.Rows.Count  
    'Прыгаем вверх до последней заполненной ячейки:  
    lastrow = Cells(nr,col).End(xlUp).Row  
    'где col - номер нужного столбца  
     
    а минимальные/максимально используемые строчки на листе определяются так:
    Row1 = ActiveWorkbook.ActiveSheet.UsedRange.Row
    Row2 = Row1 + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1
     

    Цитата:
     if cells(i:1).value=cells(j:4).value do вот здесь и есть разные файлы  

    поясните словами, что вы с чем сравниваете? Равны или НЕ равны? если вы хотите Одни и те же ячейки (одинаковый адрес), только расположенные в разных книгах - то это делается приблизительно так:
     
    set w1 = Workbook("A")
    set w2 = Workbook("B")
     
    for i:=row1 to row2
      for j=1 to MaxColumn
        if w1.cells(i,j).Value = w2.cells(i,j).Value Then
          ' код
        end if
    next j
    next i
     

    Всего записей: 2014 | Зарегистр. 12-09-2002 | Отправлено: 17:28 14-03-2007
    AndVGri

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    SERGE_BLIZNUK

    Цитата:
    а подскажите, через банальный перебор сверху вниз не быстрее будет?  

    Так то будет (n*m/2)*(n*m) просмотров. В идеале, свести всё в одномерный массив и отсортировать, с сохранением индексов ячеек. С другой стороны Dictionary, вроде как, поддерживает хеширование. Короче, проверять надо, что быстрее.
     

    Цитата:
    nr = ActiveSheet.UsedRange.Rows.Count

    Вы правы, по первой ячейке не стоит определять диапазон данных.
    Но если у автора две или более таблиц на листе?
    Тогда уж лучше через ActiveSheet.ActiveCell.CurrentRegion.Rows.Count и тоже для столбцов, при условии, что активная в требуемой таблице.  

    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 17:48 14-03-2007
    Yuk



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

    Цитата:
    rowLast = Cells(1&, 1&).End(xlDown).Row  
     
    это вернёт максимальную Строчку только для первого столбца...  

    Более того, это вернет не последнюю ячейку, а последнюю заполненную ячейку перед первой пустой или первую заполненную, если А1 пустая. Если надо последнюю ячейку листа всегда используйте UsedRange.

    Всего записей: 1182 | Зарегистр. 02-07-2001 | Отправлено: 18:01 14-03-2007
    The okk



    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    AsPAndA
    К другому файл можно обратиться:

    Код:
    Dim wbkOtherBook As Workbook
    OtherBook = Workbooks(<адрес твоей книги>).Open

     
    Размер листа определяется через UsedRange

    Код:
    Dim RowNum As Long, ColNum As Long
    'количество строк
    RowNum = Sheets(<твой лист>).UsedRange.RowsCount
    'количество столбцов
    ColNum = Sheets(<твой лист>).UsedRange.Columns.Count

    В случае, если у тебя первая строка или столбец вообще не используются, надо редактировать приведенные коды.
     

    Цитата:
    rowLast = Cells(1&, 1&).End(xlDown).Row  
    ну вот это как я понимаю ответ на мой вопрос о кол-ве строк  

    Нет. Это лишь определение строки первой не пустой ячейки в столбце А. Далеко не то же самое.

    Всего записей: 327 | Зарегистр. 16-11-2006 | Отправлено: 18:11 14-03-2007
    AsPAndA

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    А что возвращается?Последняя ячеика по вертикали или горизонтали? Мне нужна последняя по вертикали

    Всего записей: 7 | Зарегистр. 01-11-2005 | Отправлено: 18:13 14-03-2007
    Yuk



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Od_UA
    Можно использовать мой макрос "Ранжирование без пробелов" (в шапке). Затем  окрасить с помощью ColorIndex.
     
    The okk
    set забыл
     
    Добавлено:
    AsPAndA

    Цитата:
    А что возвращается?Последняя ячеика по вертикали или горизонтали? Мне нужна последняя по вертикали

    A хелп посмотреть по End и UsedRange напрягает?
    Опять же непонятно, что тебе нужно. Последняя заполненная ячейка в столбце или ячейка в последней строке рабочей области листа? Прочувствуй разницу.

    Всего записей: 1182 | Зарегистр. 02-07-2001 | Отправлено: 19:46 14-03-2007
    SERGE_BLIZNUK

    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    AndVGri
    Цитата:
    Dim pAll As New Scripting.Dictionary  
        Dim pGroup As New Scripting.Dictionary  

     
    1) у меня данный код вообще не отработал - сказал, что не позволяется создавать пользовательские типы данных!
    помогла замена на:
       Set pAll = CreateObject("Scripting.Dictionary")
       Set pGroup = CreateObject("Scripting.Dictionary")
    А почему у вас прокатило?
     
    2) вопрос в том, что я думал, что нужно решение совсем другой задачи - повторение данных одновременно в нескольких столбцах!
    А для повторов в одном столбце было отличное решение Yuk через условное форматирование!! (правда, все дубли будут раскрашены одним и тем же цветом, но часто это неважно - нужно именно увидеть повторы).
     
    Od_UA
    Цитата:
    В диапазоне А:К найти ячейки с одинаковыми данными  

    Подскажите, нужно найти строчки, в которых значения во всех столбцах совпадают
    или повторы в столбцах надо найти независимо друг от друга (как сделано выше)?
     

    Всего записей: 2014 | Зарегистр. 12-09-2002 | Отправлено: 07:06 15-03-2007
    AndVGri

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    SERGE_BLIZNUK

    Цитата:
    1) у меня данный код вообще не отработал - сказал, что не позволяется создавать пользовательские типы данных!  

    В редакторе VBA в меню Tools, пункт Reference в диалоге поставте галочку для Microsoft Scripting Runtime. Я воспользовался ранним связыванием, вы - поздним
     

    Цитата:
    2) вопрос в том, что я думал, что нужно решение совсем другой задачи - повторение данных одновременно в нескольких столбцах!  

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

    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 08:57 15-03-2007
    SERGE_BLIZNUK

    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    AndVGri

    Цитата:
    В редакторе VBA в меню Tools, пункт Reference в диалоге поставте галочку для Microsoft Scripting Runtime. Я воспользовался ранним связыванием, вы - поздним  

    Yes! СПАСИБО!!
     
    Od_UA и всем...
    По поводу условного форматирования (выделения дублей в столбце) — решение от Yuk
     

    Цитата:
    А автор вопроса - молчит

    ну значит можно пока свернуть обсуждение... Пока автор не пояснит, что ему собственно нужно то ;-))
     
    вопросец есть...
    Есть в VBA такие строчки:
       Set ExpertObj = CreateObject("Expert.Service")
       CurrentPath = ExpertObj.ReportFolder
    откуда можно узнать, где находится этот "Expert.Service" (в каком файлике EXE/DLL)?
     
     

    Всего записей: 2014 | Зарегистр. 12-09-2002 | Отправлено: 09:19 15-03-2007
    AndVGri

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    SERGE_BLIZNUK

    Цитата:
    Set ExpertObj = CreateObject("Expert.Service")
       CurrentPath = ExpertObj.ReportFolder  

    Увы получил ActiveX component can't create object - у меня такого не стоит. Попробуйте в реестре поискать по Expert.Service, COM должна где-то там иметь запись сопоставления Expert.Service некоторму CLID, а по нему можно будет и найти библиотеку, а может и сразу найтёте требуемое

    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 10:19 15-03-2007
    The okk



    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    SERGE_BLIZNUK
    Если это мелкомягкая вещь, то скорее всего достаточно просто поиском пройтись по system32.

    Всего записей: 327 | Зарегистр. 16-11-2006 | Отправлено: 10:23 15-03-2007
    SERGE_BLIZNUK

    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    AndVGri
    The okk
    Спасибо за подсказку. Так и сделаю.
    скорее всего вещь не мелкомягкая... это покупная система, работает с БД и сохраняет отчёты в Word, используюя макросы на VBA. скорее всего модуль ActiveX собственной разработки.

    Всего записей: 2014 | Зарегистр. 12-09-2002 | Отправлено: 10:50 15-03-2007
    LevT



    Platinum Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

    На таком-то листе такой-то книги есть именованный диапазон. Можно ли выудить программно сведения о нем (конкретно его границы), не открывая эту книгу? Т.е мне надо использовать ее как источник вот таких вот данных.
     

    Всего записей: 17126 | Зарегистр. 14-10-2001 | Отправлено: 12:57 15-03-2007
    The okk



    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Оригинально. - Как вызвать макрос из экселевской формулы. Это ж надо было так извратиться!

    Всего записей: 327 | Зарегистр. 16-11-2006 | Отправлено: 15:15 15-03-2007
    LevT



    Platinum Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Извращаюсь потому, что удобно пользовательский интерфейс так организовывать: говоришь юзеру, что надо выбрать диапазон на листе и назвать его определенным именем. Альтернатива - требовать от него скучного - задания числовых параметров, смысл которых для него неочевиден.
     
    А ссылку не понял, можно подробнее? Мне не из формулы, мне из кода нужно узнать границы именованного ранджа.
     
     
    ---
    И еще вопрос собственно о VBA, который я оказывается подзабыл.  
     
    Был модуль  
     

    Цитата:
    Dim m_Series As New Series
     
    Public Function GetSeries() As Series
     
            m_Series.Init2 TargetRange:=Workbooks("Пофамильно3.xls").Sheets("()Образец()").Range("A_D"), _
                        SourceWorkbookName:="По визитам.xls", _
                        SourceWorksheetName:="Визит 1", _
                        SourceNamedRangeName:="A_D_source"
             
     
     
    '    m_Series.Init FirstRow:=90, _
    '                  LastRow:=103, _
    '                  FirstColumnRef:="R#C56", _
    '                  LastColumnRef:="R#C69"
    '
        Set GetSeries = m_Series
    End Function

     
     
    Модуль - собственно обертка для моего класса Series, цель которой только вызвать "конструктор" с правильными параметрами. Плохо было в нем то, что одноразовый код инициализации вызывается каждый раз, когда клиентский код дергает GetSeries()
     
    Стал модуль
     
     

    Цитата:
    Dim m_Series As Series
     
    Public Function GetSeries() As Series
       
        If (m_Series Is Nothing) Then
            Set m_Series = New Series
     
            m_Series.Init2 ...
        End If
     
        Set GetSeries = m_Series
    End Function

     
     
    Все бы хорошо, но таких модулей-оберток несколько (это я имитирую нескольких наследников от класса Series), и я хочу свести к минимуму содержащийся в них код: полиморфизьму ради, чтобы убрать из модулей-оберток повторяющийся код, классовую логику держать все-таки не в модулях, а в классах (ну и в "утилитах класса"). Это поскольку я глубоко развращен интерфейсами и shared мемберами в .NET.
     
     
    пытаюсь проверять m_Series на Nothing в "утилите класса":
     

    Цитата:
    Dim m_Series As Series
     
    Public Function GetSeries() As Series
        Utils.Init3 (m_Series)

     
     
     
    но так не получается, пишет рантайм еррор 91 object variable not set
     
     
    Как бы это поизящнее сделать в VBA?

    Всего записей: 17126 | Зарегистр. 14-10-2001 | Отправлено: 15:50 15-03-2007 | Исправлено: LevT, 16:24 15-03-2007
    AndVGri

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    LevT
     
    Сложно сказать, как найти имена в неоткрытой книге. Если же книга не активна, то
     
    Dim pArea As Range
    'Получаем ссылку на именованный диапазон
    Set pArea = Workbooks("NeedBook").Names("NeedName").RefersToRange
     
    Debug.Print pArea.Row 'Начальная строка диапазона
    Debug.Print pArea.Rows.Count 'Число строк в диапазоне
    Debug.Print pArea.Column 'Начальный столбец диапазона
    Debug.Print pArea.Columns.Count 'Число столбцов диапазона
     
    Есть ищё имена, локальные для рабочего листа, то к ним доступ
    Set pArea = Workbooks("NeedBook").Worksheets("NeedSheet").Names("NeedName").RefersToRange

    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 16:28 15-03-2007
       

    Страницы: 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

    Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Excel VBA
    ShIvADeSt (23-04-2007 01:59): http://forum.ru-board.com/topic.cgi?forum=33&topic=8273


    Реклама на форуме Ru.Board.

    Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
    Modified by Ru.B0ard
    © Ru.B0ard 2000-2024

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru