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

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

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

 Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 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 201 202 203 204 205 206 207 208 209 210 211 212 213

Открыть новую тему     Написать ответ в эту тему

ShIvADeSt



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

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

 
Обратите внимание, этот топик для помощи в изучении и использовании VBA. Посему запросы типа "Напишите мне такой-то макрос, я VBA не знаю и знать не хочу" не приветствуются.
Древняя мудрость: "Накорми голодного рыбой и он погибнет, научи его ловить рыбу и ты спасешь его."(R)
 
Предыдущие ветки топика: Часть 1, Часть 2
 
Информация общего характера:
  • Список соответствия имен функций в английской и русской версиях 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
     
    Перечень основных ColorIndex'ов из MSDN
     

    Смежные темы:
    Программы » Microsoft Office 2019 & 365 | 2016 | 2013 | 2010 | 2007 | 2003
    Программы » OneNote | Outlook 2013 & 2016 & 2019 | Outlook 2010 | Microsoft Mathematics & Math Solver
    Программы » Word FAQ | Excel FAQ | Access FAQ
    Прикладное программирование » Word VBA | Access VBA  
    Андеграунд » Microsoft Office 2019 | 2016 | 2013 | 2010 | 2007 | 2003
    Андеграунд » OneNote | Visio | SharePoint Server | Project Server | Exchange Server
    Андеграунд » Надстройки (add-ins) и коммерческие макросы Excel
    Андеграунд » Самостоятельная сборка дистрибутивов Оffice 2007/2010/2013/2016 | MUI для Office 2007

  • Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 10:16 11-01-2010 | Исправлено: ALeXkRU, 16:42 03-08-2021
    andrewkard1980

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

    Код:
    Sub test()
    Dim aNA(), aNB(), aPA(), aPB()
    Dim i&, l&
    Dim sA$, sB$
     
        aNA() = Range("A1:A34")
        aNB() = Range("E1:E34")
        aPA() = Range("B1:B34")
        aPB() = Range("F1:F34")
         
        For i = 1 To UBound(aNA)
            For l = 1 To UBound(aNB)
                sA = aNA(i, 1)
                sB = aNB(l, 1)
                   
                sA = Replace(sA, ".", "")
                sA = Replace(sA, ",", "")
                sA = Replace(sA, "-", "")
                sA = Replace(sA, " ", "")
                sA = Replace(sA, "_", "")
                 
                sB = Replace(sB, ".", "")
                sB = Replace(sB, ",", "")
                sB = Replace(sB, "-", "")
                sB = Replace(sB, " ", "")
                sB = Replace(sB, "_", "")
                 
                If sB Like "*" & sA & "*" Or sA Like "*" & sB & "*" Then
                    aPA(i, 1) = Application.WorksheetFunction.Min(aPA(i, 1), aPB(l, 1))
                End If
            Next l
        Next i
         
        Range("H1:H34") = aNA
        Range("I1:I34") = aPA
     
    End Sub

    Всего записей: 209 | Зарегистр. 01-05-2010 | Отправлено: 17:29 15-02-2013 | Исправлено: andrewkard1980, 17:38 15-02-2013
    Dmitriy05



    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Есть файл с заголовками столбцов в первой строке.
    Задача: Удалить столбы, не содеражащие никаких данных кроме заголовка.
    Проблема в том, что программа не всегда правильно определяет отсутствие данных в ячейке:
     
    Есть пустая ячейка для которой одновременно:
    (C2="")  =  ИСТИНА  
    СЧЕТЕСЛИ(C2;"<>""")  =  1
     
    Сравнение с "" дает верный результат. Но проверка каждой ячейки в столбце займет много времени. Если ли способ сделать это быстрее?

    Всего записей: 2514 | Зарегистр. 03-08-2005 | Отправлено: 22:10 18-02-2013
    andrewkard1980

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Может как то так:
    =ЕСЛИ(СЧЁТЕСЛИ(C:C;">0")+СЧЁТЕСЛИ(C:C;">*")=1;1;0)

    Всего записей: 209 | Зарегистр. 01-05-2010 | Отправлено: 00:39 19-02-2013 | Исправлено: andrewkard1980, 00:41 19-02-2013
    SAS888

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Dmitriy05
    Например, Так:

    Код:
    Sub qq()
        Dim i As Integer
        For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
            If Intersect(Columns(i), Rows("2:" & Rows.Count)).Text = "" Then Columns(i).Delete
        Next
    End Sub


    Всего записей: 398 | Зарегистр. 31-10-2007 | Отправлено: 08:18 20-02-2013 | Исправлено: SAS888, 11:17 21-02-2013
    panda3

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Dmitriy05
    =(СЧИТАТЬПУСТОТЫ(Диапазон)=ЧСТРОК(Диапазон))
     
    Добавлено:
    SAS888
    Проверять текст ячейки, когда нужны данные, вообще, очень плохая идея. Например, задайте для ячейки формат "#;" и введите туда -100. Ваша программа определит ее как пустую. ("Видишь суслика? ... А он есть!"). Равно как и наоборот, ячейка с заданной маской формата, в которую введена пустая строка, будет считаться заполненной.

    Всего записей: 203 | Зарегистр. 06-02-2007 | Отправлено: 23:00 21-02-2013
    SAS888

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

    Цитата:
    Проверять текст ячейки, когда нужны данные, вообще, очень плохая идея.
    Дело в том, что сначала нужно определиться: что считать пустой ячейкой. Считать ли пустой ячейку, которая содержит функцию, возвращающую пустое значение? Считать ли пустой ячейку, которая содержит примечание? Считать ли пустой ячейку, которая содержит маску формата и значение которой не отображается? И т. п.
    Предлагая свой вариант, я счел, что автору как раз и требуется удалить столбцы, значения в которых не видимы. Кстати, просьбу автора удалить требуемые столбцы формулами не осуществить...
    Ну, а если, все-таки, автору нужно удалить ячейки, содержащие именно данные (не важно, видимые в ячейке, или нет), то проще поступить так:

    Код:
    Sub qq()
        Dim i As Integer
        For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
            If Application.CountA(Columns(i)) = 1 Then Columns(i).Delete
        Next
    End Sub

    P.S. Имеется ввиду, что все столбцы имеют 1-ю строку с заголовками.

    Всего записей: 398 | Зарегистр. 31-10-2007 | Отправлено: 06:14 22-02-2013
    Dmitriy05



    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    andrewkard1980
    Работает, но ячейки с пробелами считает не как содержащие значения.
     
    SAS888
    Быстро отработало. Не проверял на пробелы.
     
    panda3
    Для колонки только с заголовком:
    СЧИТАТЬПУСТОТЫ возврашает 65535
    а ЧСТРОК должно показать 65536 - надо проверить что выдаст у меня.
     

    Цитата:
    удалить требуемые столбцы формулами не осуществить...  

    Почему нет?
    У меня заработал такой код:

    Код:
     
    Dim Str1 As String
    Dim Str2 As String
    Dim Totalrows as integer
    Dim EmptyRows
    Dim X As Integer
    Sub DelEmptyColumns()
    x = 1
    Str2 = "Dummy"
    Do While Str2 <> ""
    Str2 = Sheets("Лист1").Cells(1, x).Value
    TotalRows:= Application.WorksheetFunction.CountIf(Columns(x),"<>''")
    EmptylRows:= Application.WorksheetFunction.CountBlank(Columns(x))
    If (TotalRows - EmptylRows) = 1
    Then
    Columns(x).Delete
    Else
    x = x + 1
    End If
    Loop  
    End Sub
     

     
    Извиняюсь, что забыл уточнить источник выгрузки  - база данных. Пустые ячейки = NULL значения. Формул нет. Значений '' или "" пока не было.

    Всего записей: 2514 | Зарегистр. 03-08-2005 | Отправлено: 20:50 22-02-2013
    SAS888

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Dmitriy05
    Много лишнего. Чем Вас не устраивает предложенный мною вариант? При его выполнении будут удалены все столбцы на активном листе, в которых кроме заголовка, расположенного в 1-й строке, нет данных. Пробел считается за действительное значение. Если столбцов много, то, целесообразно в начало кода поместить строку
    Код:
    Application.ScreenUpdating = False
    которая запретит обновление экрана на время выполнения процедуры.

    Всего записей: 398 | Зарегистр. 31-10-2007 | Отправлено: 08:35 23-02-2013
    Dmitriy05



    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    SAS888
    Скрипт из 7го сообщения выдает ошибку 1004 (Application or object-defined error) на некоторых колонках:
     
    1) Содержащие числа, отформатированные как текст
    2) Без указания формата (так было выгружено)

    Всего записей: 2514 | Зарегистр. 03-08-2005 | Отправлено: 21:14 24-02-2013
    panda3

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Имейте в виду, что CountA считает и пустые строки тоже.
    Dmitriy05
    а зачем два раза считать? и зачем все строки листа считать? я бы так написал:

    Код:
      Dim c As Range, d As Range
      For Each c In ActiveSheet.UsedRange.Columns
        If WorksheetFunction.CountBlank(c) = c.Rows.Count - 1 Then
          If d Is Nothing Then Set d = c Else Set d = Union(d, c)
        End If
      Next c
      If Not d Is Nothing Then d.Delete

    Всего записей: 203 | Зарегистр. 06-02-2007 | Отправлено: 01:54 25-02-2013
    Dmitriy05



    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    panda3
    "Метод Delete из класса Range завершен неверно"

    Всего записей: 2514 | Зарегистр. 03-08-2005 | Отправлено: 20:33 26-02-2013
    igorsimerin

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    подскажите пожалуйста! у меня в одной таблице макрос считывает и копирует данные с другой! все хорошо было пока второй таблицей не начали пользоваться другие пользователи! можно ли прописать как нибудь чтобы макрос при необходимости нажал кнопку "только чтение" и продолжил сканировать!

    Всего записей: 1 | Зарегистр. 27-02-2013 | Отправлено: 21:59 27-02-2013
    panda3

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    igorsimerin
    Может стоит сразу открывать в режиме "только чтение"?

    Всего записей: 203 | Зарегистр. 06-02-2007 | Отправлено: 00:33 28-02-2013
    aidomars



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Как в VBA определить время простоя компьютера?
     
    Добавлено:
    Нашел

    Код:
    Declare Function GetLastInputInfo Lib "USER32.DLL" (plii As LASTINPUTINFO) As Long
    Private Declare Function GetTickCount Lib "kernel32" () As Long
     
    Private Type LASTINPUTINFO
      cbSize As Long
      dwTime As Long
    End Type
     
    Function Interval()
        Dim plii As LASTINPUTINFO
        plii.cbSize = Len(plii)
        Call GetLastInputInfo(plii)
        Interval = FormatNumber((GetTickCount() - plii.dwTime) / 1000, 2)
    End Function

    Всего записей: 982 | Зарегистр. 23-04-2007 | Отправлено: 11:20 28-02-2013
    Ange30

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Подробнее... [/more]

    Всего записей: 1 | Зарегистр. 28-02-2013 | Отправлено: 15:51 28-02-2013 | Исправлено: Ange30, 16:05 28-02-2013
    andrewkard1980

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Ange30
    Если одновременно то можно как то так:
     
    If Cells(i, j) = Cells(i, b) AND Cells(i, j) = Cells(i, d) then
    Cells(i, y) = 1
    Else
    Cells(i, y) = 0
    End if

    Всего записей: 209 | Зарегистр. 01-05-2010 | Отправлено: 19:52 28-02-2013
    Sterh84

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Добрый день.
    Задача отобрать все строки в 4ом столбце все числа начинаются на 771 а затем перенести их на отдельный лист. Пробывал делать автофильтр руками (выбирал начинается на 771) не работает, пробывал в макросе забить следующий код:
     

    Код:
     
    Selection.AutoFilter Field:=4, Criteria1:="771*", Operator:=xlFilterValues
     

    Так же не завелось, можно ли регулярное выражение заставить так отработать чтобы потом скопировать нужные строки?
    Или может есть корректный варинат для работы автофильтра ?

    Всего записей: 318 | Зарегистр. 03-10-2006 | Отправлено: 21:44 01-03-2013
    SKi

    Junior Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Добрый день!
     
    Excel 2007 (rus)
    Vista (rus)
     

    Код:
     
    Dim wba As Workbook
    Set wba = ActiveWorkbook
    lStr_Dir = wba.Path
     

    Итог: lStr_Dir = C:\Проверка связи\
     
    Макрос отсылает по ФТП файл на сервер. Из-за кириллицы в пути к файлу отсылка не идёт.
    Просто переименовать папку нельзя :(
    Есть ли решение?
     
    Спасибо.

    Всего записей: 124 | Зарегистр. 17-04-2004 | Отправлено: 16:28 02-03-2013
    psiho

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

    Цитата:
    Из-за кириллицы в пути к файлу отсылка не идёт.

     
    Возможно нужно путь к файлу в DOS кодировку перевести. Для этого в начале модуля с Вашим кодом объявите функцию:

    Код:
    Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

     
    Затем добавьте вот эту функцию:

    Код:
    Function WinToDOS(sourstr$) As String
        WinToDOS = Space$(Len(sourstr))
        CharToOem sourstr, WinToDOS
    End Function

     
    Теперь нужно перевести путь к файлу в DOS-кодировку:

    Код:
    lStr_Dir = WinToDOS(wba.Path)
    .

    Всего записей: 247 | Зарегистр. 26-10-2006 | Отправлено: 20:30 02-03-2013 | Исправлено: psiho, 20:31 02-03-2013
    SKi

    Junior Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Спасибо за ответ.
    Я так и сделал потом. Всё хорошо, ftp.exe файл видит и отправляет, если батник из ДОСа запускать. Выяснилось, что cmd.exe не может запустить его из VBA, т.к. опять русские буквы, хоть и перекодированы.

    Код:
     
    strDirectoryListFtp = text866(wba.Path)
    strDirectoryListFtpZZZ = strDirectoryListFtp & "\xlsftp"
     
    .....................
     
    AppFile = strDirectoryLisFtptZZZ & ".bat"
    Shell "cmd.exe /c " & Chr(34) & AppFile & Chr(34)
     
    Пробовал даже так:
    Shell "cmd.exe /c cd " & Chr(34) & strDirectoryListFtp & "\" & Chr(34) & " && xlsftp.bat"
     

    Осталось только отправить файл и тут такой затык :(
    Обидно ...
     
    Добавлено:
    Победил:

    Код:
     
    Dim wba As Workbook  
    Set wba = ActiveWorkbook  
    lStr_Dir = wba.Path
     
    ..................................
     
    Shell "cmd.exe /c cd " & Chr(34) & lStr_Dir & "\" & Chr(34) & " && xlsftp.bat"
     

    Всего записей: 124 | Зарегистр. 17-04-2004 | Отправлено: 21:45 02-03-2013
    Открыть новую тему     Написать ответ в эту тему

    Страницы: 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 201 202 203 204 205 206 207 208 209 210 211 212 213

    Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Excel VBA (часть 3)


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

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

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru