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

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

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

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

   

ShIvADeSt



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

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

 
Обратите внимание, этот топик для помощи в изучении и использовании VBA. Посему запросы типа "Напишите мне такой-то макрос, я VBA не знаю и знать не хочу" не приветствуются.
Древняя мудрость: "Накорми голодного рыбой и он погибнет, научи его ловить рыбу и ты спасешь его."(R)
 
Предыдущие ветки топика: Часть 1
 
Информация общего характера:
  • Список соответствия имен функций в английской и русской версиях Excel
  • Описание Microsoft Excel File Format (eng.)
     
    Рекомендации:
    Если у Вас есть проблема, не решаемая стандартными средствами 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.
  • Приемы, хитрости, трюки и нюансы работы в Microsoft Excel - сайт "Планета Excel", целиком посвященный Excel и всему, что с ним связано.
  • Microsoft Excel: Таблицы и VBA. Справочник. Вопросы и Ответы. Советы. Примеры.  
     
    Родственные топики:
  • Вопросы по работе с MS Excel - Excel FAQ - часть 1, часть 2, часть 3
  • Технические проблемы с MS Office 2003 или Office XP.
  • Word VBA все вопросы по Word VBA туда
  • Access все вопросы по программированию в Access туда
  • Книжульки по VBA - книги по программированию с использованием VBA
     
    Конкретные вопросы:
    Форма-заставка
    Как запустить макрос при изменении положения курсора или значения ячейки
  • Пример 1
  • Пример 2
  • Пример 3 (проверка области)
  • Пример 4
  • Пример 5
    Зацикливание в функции Change или SelectionChange
     
    Ранжирование без пробелов (макрос включает функции сортировки массива и удаления дубликатов, работает и в Excel 2007)
  • под Office 97
     
    Добавление в главное меню своего пункта, ассоциированного с макросом
    Создание ярлыка на рабочем столе
    Снятие защиты листа при забытом пароле
    Смена раскладки клавиатуры
    Скролл формы колесом прокрутки мыши
    Оптимизация кода по быстродействию использованием массивов
    Найти "чужое" окно и нажать в нем кнопку (вписать текст в текстовое поле)
    Работа с UNICODE-символами в VBA: запись, чтение из ячейки, перевод в ASС и обратно
    Как программно подключить дополнительные библиотеки (например, "Microsoft Scripting Runtime" или "Microsoft ActiveX Data Objects 2.8 Library) через References
    • Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 01:58 23-04-2007 | Исправлено: JekG, 22:32 10-01-2010
    ecolesnicov

    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    DocBeen
    А еще можно через "Сводные Таблицы". Которые тоже управляются программно. Но если я делал программно, то отсортировал бы диапазон, а потом бы прошелся в цикле подсчитывая записи. Соответственно промежуточные итоги и сводные таблицы не использовал бы ...
     
    Например так бы:
    1) Сначала сортировка вызовом соответствующей фичи из кода (как это писать - можешь увидеть записав макрос средствами ёхеля).
     
    2) А потом вот так бы:

    Код:
     
      Set inSh = Worksheets("Лист1")          'определяем имя исходной таблицы
      Set outSh = Worksheets("Лист2")         'определяем имя сводной таблицы
       
      r1 = 2                                  'определяем начальную строку в исходной таблице (2 - т.к. 1-ая строка например занята шапкой)
      r2 = 1                                  'определяем начальную строку в сводной таблице
       
      Do While inSh.Cells(r1, 1) <> ""        'цикл по строкам исходной таблицы, до тех пор пока не закончиться НЕпустые строки в исходной таблице в 1-ой колоке (там где имя)
        If inSh.Cells(r1, 1) <> inSh.Cells(r1 - 1, 1) Then          'проверка условия, что имя на предыдущей строке отличается от имени на текущей строке
          r2 = r2 + 1                                               'если оно таки отличается, то добавление строки в сводную таблицу
          outSh.Cells(r2, 1) = inSh.Cells(r1, 1)                    'а также имени в сводную таблицу
          outSh.Cells(r2, 2).ClearContents                          'а также очищается 2-ая колонка (на всякий случай)
        End If
        outSh.Cells(r2, 2) = outSh.Cells(r2, 2) + inSh.Cells(r1, 2) 'суммирование цифровых значений (суммируется текущее значение текущей строки сводной таблицы и значение из исходной таблицы)
        r1 = r1 + 1                           'переход на новую строку в исходной таблице
      Loop
     
     
    Всего записей: 251 | Зарегистр. 05-08-2005 | Отправлено: 16:47 21-02-2008
    ol7ca

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

    Цитата:
     
    Не совсем понятно. Т.е. у Вас есть измененный файл (1) и старый файл без последних изменений (2). Так? Если "да", то что мешает сравнить 1 и 2 столбцы файлов (например, по строкам), и добавить и сделать все что нужно с новыми данными? А обновлять только столбец 3.

     
    Все именно так. Мешает отсутствие знаний-)  
    мне нужны хотя бы примеры подобных процедур.
    Буду благодарен за помощь.
    Всего записей: 125 | Зарегистр. 01-02-2007 | Отправлено: 17:07 21-02-2008
    DavidKATS

    Newbie    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Такая проблема. Когда ставлю галочку Общего доступа к книге, перестает работать метод Unprotect
    Всего записей: 10 | Зарегистр. 06-08-2007 | Отправлено: 18:50 21-02-2008
    SAS888

    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    ol7ca
    Посмотрите пример здесь: Ссылка  
    Пусть файл "1.xls" - рабочий файл. Файл "2.xls" - Файл, содержащий то, что Вы требуете.
    Для теста, попробуйте добавить данные в файл 1 и (или) изменить данные в столбце "C". Затем в файле 2 запустите макрос ( файл 1 должен находиться в той же директории, что и файл 2, необязательно открыт). Поэкспериментируйте с датой. Сортировка и отмена окраски должна происходить при изменении номера текущего месяца. Все ли так, как Вы хотели?
    Всего записей: 398 | Зарегистр. 31-10-2007 | Отправлено: 10:58 22-02-2008
    rushclub

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Всем привет, есть такой вопрос на знание макрсов- если можете помогите-надо срочно и нету времени во всем самому спокойно разобраться
     
    Короче есть поле дата и поле Today, если поле Today и дата совпадают то можно вписать данные в ячейку рядом с датой, а остальные ячейки блокируются.  
     
    С уважением, Алексей
    Всего записей: 41 | Зарегистр. 19-05-2006 | Отправлено: 15:27 22-02-2008
    DavidKATS

    Newbie    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    rushclub
    Попробуй вот это:
     
    Option Explicit
    Private Sub Workbook_Open()
        Dim rng As Range
        Dim dtToday As Date ' переменная, где хранится сегодняшняя дата
        ' Диапазон B1:B100 содержит список дат. Если в этом диапазоне найдется дата,   которая совпадает с текущей (dtToday),
        ' то ячейка справа от нее становится доступной для записи
         
        dtToday = Now()
        Set rng = Sheets("Лист1").Range("B1:B100").Find(what:=dtToday)
        If Not rng Is Nothing Then rng.Offset(, 1).Locked = False
        Sheets("Лист1").Protect
    End Sub
     
    Добавлено:
    Такая проблема. Когда ставлю галочку Общего доступа к книге, перестает работать метод Unprotect
    Всего записей: 10 | Зарегистр. 06-08-2007 | Отправлено: 16:13 22-02-2008 | Исправлено: DavidKATS, 17:03 22-02-2008
    vasiliy74



    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    While IsError(Excel.WorksheetFunction.Find(",", cc1, index_map)) <> True
     не срабатывает, просматриваю в watches и понимаю что IsError не отрабатывает, пишет что невозможно получить значение, так я и на то его поставил сюда что бы он определял когда значение получать возможно а когда нет.
    Всего записей: 289 | Зарегистр. 21-02-2006 | Отправлено: 23:20 24-02-2008
    SERGE_BLIZNUK

    Silver Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    vasiliy74 вот, может поможет пример кода...
    Копирайт чей не помню.. но выдернуто однозначно с какого-то форума:

    Код:
     
    >уважаемые подскажите, как в листе excel найти строку со словом  
    >  например "test" и ниже ее вставить строку со словами "test_test"?  
     
    Sub Макрос1()
    Dim iRange As Range
    Dim iString As String
        iString = "Test"
        Set iRange = ActiveSheet.UsedRange.Find(what:=iString, LookIn:=xlValues, LookAt:=xlWhole)
        If iRange Is Nothing Then
            MsgBox "Текст " & iString & " на листе не найден!", vbExclamation, "Ошибка"
            Exit Sub
        End If
        Rows(iRange.Row + 1).Insert Shift:=xlDown
        Cells(iRange.Row + 1, iRange.Column) = "Test-Test"
    End Sub
     
    Всего записей: 2014 | Зарегистр. 12-09-2002 | Отправлено: 03:19 25-02-2008
    CEMEH



    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    ВОПРОС
     
    На форме несколько CheckBox (10 штук)
    Каким образом сделать следующее:
    For X=1 to 10
    IF CheckBox(X)= true then 'выполняем если CheckBox(х) с галкой
    Next
     
    Собственно программа ругается на выражение CheckBox(x)
    Всего записей: 237 | Зарегистр. 17-09-2006 | Отправлено: 14:26 25-02-2008
    h1dden



    Newbie    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Попал в затык
     
    Есть конструкция
     
    With Application.FileSearch
        .Filename = "*" + ".xls"
        .LookIn = path_2found
            If .Execute > 0 Then
                ffc = .FoundFiles.Count
            Else
               MsgBox "По заданным параметрам файлы не найдены!", vbExclamation
               Exit Sub
            End If
    End With
     
    На всех машинах пашет без проблем, а на одной .execute всегда возвращает 0
    Как побороть - ума не приложу.
    Везде стоит Excel 2003, сервис пак 3, на той машине, где не работает даже антивирус удалил - не помогло.
    Всего записей: 5 | Зарегистр. 23-02-2006 | Отправлено: 14:29 25-02-2008
    AndVGri

    Advanced Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    CEMEH
    Массивов объектов в VBA нет. Поэтому самостоятельно сведи их, например, в коллекцию, а уж к её элементам и обращайся
     

    Код:
     
    Private pCheckCol As New Collection
     
    Private Sub UserFrom_Activate()
       Dim pCheck As MSForms.Control
       For Each pCheck In Me.Controls
           If TypeOf pCheck Is MSForms.CheckBox Then pCheckCol.Add pCheck
       Next pCheck
    End Sub
     
    '....
     For X=1 to pCheckCol.Count
    IF pCheckCol(X).Value then 'выполняем если CheckBox(х) с галкой
    Next  
    '....
     

    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 16:00 25-02-2008
    ol7ca

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    SAS888
     
    Большое спасибо! Начал тестировать. В основном все как надо. Не работает сортировка и изменение цвета с красного на черный в начале след. периода, но я постараюсь сам с этим справиться.
    Еще раз спасибо.
    Всего записей: 125 | Зарегистр. 01-02-2007 | Отправлено: 17:02 25-02-2008
    SAS888

    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    ol7ca
    В предложенном примере сравнивается месяц системной (установленной на компьютере) даты и месяц даты последнего сохранения (изменения) файла. Т.е. если мы изменим и сохраним файл, а следующее его открытие произойдет в следующем месяце, то все должно сработать. Поэкспериментируйте, я такой тест проводил. Может нужно не так?
     
    Добавлено:
    h1dden
    Вообще-то, не понятно, как компилятор воспринимает конструкцию
    Цитата:
    .Filename = "*" + ".xls"

    В коде я бы использовал:

    Код:
    With Application.FileSearch
            .NewSearch
            .LookIn = path_2found ' Надеюсь, что путь задан корректно
            .Filename = "*.xls"
            .Execute
            If .FoundFiles.Count = 0 Then
                MsgBox "По заданным параметрам файлы не найдены!", vbExclamation
                Exit Sub
            End If
        End With

    Всего записей: 398 | Зарегистр. 31-10-2007 | Отправлено: 05:03 26-02-2008 | Исправлено: SAS888, 05:18 26-02-2008
    DmitriC



    Advanced Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Люди, подскажите как решить проблему.
    Есть Excel'евский документ, состоящий из двух страниц. Его нужно отпечатывать на одном листе бумаги с двух сторон. Как сделать, чтобы содержимое печаталось с зеркальными полями? В простейшем случае можно было бы повесить две кнопки на лист с такими макросами:
     

    Цитата:
    Private Sub Page1Butt_Click()
     With ActiveSheet.PageSetup
      .LeftMargin = Application.CentimetersToPoints(3)
      .RightMargin = Application.CentimetersToPoints(0.5)
     End With
     ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1
    End Sub
     
    Private Sub Page2Butt_Click()
     With ActiveSheet.PageSetup
      .LeftMargin = Application.CentimetersToPoints(0.5)
      .RightMargin = Application.CentimetersToPoints(3)
     End With
     ActiveWindow.SelectedSheets.PrintOut From:=2, To:=2, Copies:=1
    End Sub

     
    Но проблема в том, что документ будет печататься на принтере, поддерживающем двухстороннюю печать (чтобы не переворачивать листы вручную) и нужно заставить Excel "на ходу" переворачивать поля. То есть мы должны нажимать всего одну кнопку для печати этого документа.
     
    Можно ли такое сделать и как?
    Всего записей: 707 | Зарегистр. 15-12-2005 | Отправлено: 14:14 26-02-2008
    ol7ca

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

    Цитата:
    В предложенном примере сравнивается месяц системной (установленной на компьютере) даты и месяц даты последнего сохранения (изменения) файла. Т.е. если мы изменим и сохраним файл, а следующее его открытие произойдет в следующем месяце, то все должно сработать. Поэкспериментируйте, я такой тест проводил. Может нужно не так?  

     
    как ни тестировал - сортировка и изменение цвета не работают(
    (лучше сделать, чтбы можно было изменять уже на следующий день, если можно)
    и еще, из файла 1 в файл 2 должны копироваться имена ячеeк. хотя можно и в файл 2 вставить мой скрипт присвоения имен.
     
    еще один вопрос,
    как можно к числу в таком формате 20-010-90-198-456
    прибавить 1 к последнему числу, чтобы получилось 20-010-90-198-457
    эту замену надо делать в скрипте.
     
    спасибо.
     
    Добавлено:

    Цитата:
    сортировка и изменение цвета не работают(  

    я закомментировал первый оператор IF
    сейчас с цветом все ОК
    но сортировка не работает
    Всего записей: 125 | Зарегистр. 01-02-2007 | Отправлено: 18:50 26-02-2008 | Исправлено: ol7ca, 21:20 26-02-2008
    AndVGri

    Advanced Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    DmitriC
    А что мешает объединить две процедуры в одну? (не сталкивался с устройствами двусторонней печати)
    ol7ca

    Код:
     
    Public Function MySum(ByVal ToValue As String, ByVal AddValue As Double) As String
        MySum = Format$(CDbl(Replace(ToValue, "-", "")) + AddValue, "00-000-00-000-000")
    End Function
     
    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 03:24 27-02-2008
    SAS888

    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    ol7ca
    Примите мои извинения.Вот исправленный файл. Добавлены упущенные ссылки на рабочую книгу и изменено условие сортировки и изменения цвета (будет происходить на следующий день).
    Всего записей: 398 | Зарегистр. 31-10-2007 | Отправлено: 07:43 27-02-2008
    Mint86



    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Есть такая проблема, надо скопировать определенный диапозон ячеек и вставить в новый документ Word.
     
    Сам, в VBA новичек и добился (с помощью примереов из шапки и книг) только выделения нажного диапозона и копирования его в буфер обмена.
     
     
    Вот пример
     
    http://slil.ru/25520149
    Всего записей: 166 | Зарегистр. 25-06-2007 | Отправлено: 08:39 27-02-2008
    DmitriC



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

    Цитата:
    А что мешает объединить две процедуры в одну? (не сталкивался с устройствами двусторонней печати)

     
    Если их объединить, то принтер печатает не с двух сторон, а на двух листах.
    Всего записей: 707 | Зарегистр. 15-12-2005 | Отправлено: 09:02 27-02-2008
    SAS888

    Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Mint86
    Если то, что нужно вставить, находится в буфере обмена, то можно добавить к Вашему коду следующее:

    Код:
    Dim wdApp As Object, wdDoc As Object ' объявляем переменные
         
    'Открываем Word и файл "Pattern" (позднее связывание)
     
        Set wdApp = CreateObject("Word.Application")
        On Error Resume Next
         
    'Если шаблон "Pattern.doc" в другой папке, то прописать полный путь аргумента
    'Например ...Open("C:\Temp\Pattern.doc")
     
        Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Pattern.doc")
        If Err <> 0 Then
            MsgBox "Файл Pattern не найден"
            Exit Sub
        End If
        wdApp.Visible = True
         
    'Вставляем в Word данные из буфера обмена
     
        SendKeys "+{Insert}", True
         
    'Уничтожим созданные объекты (освобождая используемую память)
     
        Set wdApp = Nothing
        Set wdDoc = Nothing
    Всего записей: 398 | Зарегистр. 31-10-2007 | Отправлено: 09:16 27-02-2008
       

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

    Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Excel VBA (часть 2)
    ShIvADeSt (11-01-2010 10:17): http://forum.ru-board.com/topic.cgi?forum=33&topic=10903


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

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

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru