Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
Как проверить наличие директории не сбивая функцию Dir?
 
Здравствуйте!

На VBA в цикле открываю файлы выбираемой папки, используя функцию Dir. В этом же цикле периодически надо создавать несуществующие директории, для чего предварительно проверяю их наличие той же Dir. В результате после проверки в конце цикла, когда пытаюсь взять следующий файл, возникает ошибка, как понимаю из-а того, что вызывал функцию Dir с другими параметрами для проверки наличия директории.

Как проверить наличие директории, не нарушив последовательность выбора файлов из директории?

Вот код всей процедуры:
Код
Sub arrange_in_folders()
    Dim File, Path, FileContent, region As String
    Dim objFileSys As Object
    Dim i, j As Integer
    
    'выбираем папку с файлами-источниками информации
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "OK"
        .Title = "Выберите папку, содержащую файлы"
        If .Show = 0 Then
            Exit Sub
        End If
        Path = .SelectedItems(1)
    End With
    
    File = Dir(PathName:=Path + "\*.xml")
    
    Set objFileSys = CreateObject("Scripting.FileSystemObject")
    
    Do Until File = "" 'пока не закончатся файлы
        FileContent = objFileSys.OpenTextFile(Path + "\" + File).ReadAll
        i = InStr(1, FileContent, "<RegionId>")
        j = InStr(1, FileContent, "</RegionId>")
        If InStr(1, FileContent, "<RegionId>") Then
            region = Mid(FileContent, i + 10, j - i - 10)
            If Dir(Path + "\" + region, vbDirectory) = "" Then MkDir Path + "\" + region
        End If
        File = Dir
    Loop

    Set File = Nothing
    Set Path = Nothing
    Set FileContent = Nothing
End Sub
Изменено: borro - 18 Ноя 2019 15:14:57
желаю Вам счастья
Почему не известен тип данных
 
Здравствуйте!

Начал в персональной книге макросов писать код процедуры, которая должна производить в указанной папке поиск по содержимому больших(до 12 МБ) xml файлов значения определенного атрибута с именем Region. Взял с другого форума код и компилятор споткнулся на первой же строке:
Код
Dim Node2 As IXMLDOMNodeList
сообщением User-defined type is not defined. Excel 2016

Как исправить, подскажите, пожалуйста
Изменено: borro - 18 Ноя 2019 10:26:50
желаю Вам счастья
Как заставить эксель считать, что в ячейке значение одно, но отображалось бы другое
 
Здравствуйте!

Скажите, можно сделать в Экселе так, чтобы после ввода в ячейку значения, все формулы, в которых  участвует эта ячейка, считали что в ней то, что введено, но сама ячейка отображала бы какой-то текст, зависящий от того, что было введено в ячейку.
Например ввели 1 - в ячейке отображается текст "Su", 2 - "Ma" и т.п.
желаю Вам счастья
Макрос для парсинга географических адресов
 
Здравствуйте!

Скажите, кто-нибудь встречал хороший макрос для разбивки строки почтового адреса в отдельные столбцы вида Регион, Район, Город, Нас.Пункт, улица, дом, кв. ?
желаю Вам счастья
Как сделать так, чтобы по умолчанию запускался 64-разрядный эксель?
 
Здравствуйте!

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

Есть таблица на тысячи строк, в которой столбец ИНН бывает не заполнен. Есть ли какая-то техника, которая бы проставила автоматом ИНН там, где он не проставлен, опираясь на имеющиеся ИНН в строках с такими же значениями в полях Наименование потребителя и РЭС?
желаю Вам счастья
Неправильная строка шаблона
 
Здравствуйте!

Написал вот такую функцию:
Код
Function ПОЛУЧИТЬСЕРИЙНИК(Строка As String)
    Dim str As String
    str = Trim(Строка)
    If Len(str) > 1 Then
        Do While str Like "*[;:-/]"
            str = Trim(Left(str, Len(str) - 1))
        Loop
        ПОЛУЧИТЬСЕРИЙНИК = Trim(Replace(Replace(Replace(Replace(Replace(Строка, "сч. №", "", , , vbTextCompare), "сч.№", "", , , vbTextCompare), "№", ""), ",", ""), ".", ""))
    End If
    ПОЛУЧИТЬСЕРИЙНИК = str

End Function
выполнение которой приводит к появлению ошибки Invalid pattern string на строке с do while.  Этот цикл удаляет странные символы в конце строки, но не в середине или в начале строки

Скажите, пожалуйста, в чем ошибка в шаблоне?

Разобрался, надо было так:
Код
Function ПОЛУЧИТЬСЕРИЙНИК(Строка As String)
    Dim str As String
    str = Trim(Строка)
    If Len(str) > 1 Then
        Do While str Like "*[;:-\/\\]" And Len(str) > 1
            str = Trim(Left(str, Len(str) - 1))
        Loop
        ПОЛУЧИТЬСЕРИЙНИК = Trim(Replace(Replace(Replace(Replace(Replace(Replace(str, "сч. №", "", , , vbTextCompare), "сч.№", "", , , vbTextCompare), "№", ""), ",", ""), ".", ""), "*", ""))
    Else
        ПОЛУЧИТЬСЕРИЙНИК = str
    End If
End Function
Изменено: borro - 15 Май 2019 12:36:30
желаю Вам счастья
Можно ли создать обработчик кнопки без применения программирования в VBA?
 
Здравствуйте!

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

В приложенном файле есть столбец А, значения в котором могут начинаться с нулей, которые не введены в качестве значений, а обусловлены примененным форматированием.
Скажите, как можно эти виртуальные нули превратить в реальные? Когда я копирую такие значения в другую книгу, и они там исчезают, чего не должно быть. Ищу решение, которое можно было применить сразу ко всему столбцу, поскольку подобные значения раскиданы по всему столбцу неравномерно. Можно на VBA.
желаю Вам счастья
Почему при копировании берутся и скрытые ячейки?
 
Здравствуйте!

Попытался доработать чей-то макрос и сделать так, чтобы он копировал только видимые ячейки в другой выбираемый видимый диапазон, но почему-то не получается.
Вот код макроса:
Код
Sub PasteToVisible()
    Dim copyrng As Range, pasterng As Range
    Dim cell As Range, i As Long, newrng As Range
  
   'запрашиваем у пользователя по очереди диапазоны копирования и вставки
    Set copyrng = Application.InputBox("Диапазон копирования", "Запрос", Type:=8)
    Set pasterng = Application.InputBox("Диапазон вставки", "Запрос", Type:=8)
    
    'проверяем, чтобы они были одинакового размера
    If pasterng.SpecialCells(xlCellTypeVisible).Cells.Count <> copyrng.SpecialCells(xlCellTypeVisible).Cells.Count Then
        MsgBox "Диапазоны копирования и вставки разного размера!", vbCritical
        Exit Sub
    End If
  
    i = 1
    For Each cell In pasterng
        If cell.EntireRow.Hidden = False Then
            cell.value = copyrng.SpecialCells(xlCellTypeVisible).Cells(i).value
            i = i + 1
        End If
    Next cell
End Sub

Почему-то конструкция copyrng.SpecialCells(xlCellTypeVisible).Cells(i).value залезает в скрытые ячейки.
Как это можно исправить?
Изменено: borro - 29 Мар 2019 11:55:39
желаю Вам счастья
Функция листа - аналог like для поиска по шаблону
 
Здравствуйте!

Потребовалось в ячейку вставить функцию, которая бы определяла соответствует ли ячейка,скажем, слева от неё шаблону, который используется для оператора like в VBA. Но не нашел, что написать.
Например надо в столбце значений найти все ФИО, которые соответствуют шаблону "*  ?. ?." для оператора like.
Есть ли такая стандартная функция в Excel 2016?
желаю Вам счастья
Почему несоответствие типов?
 
Здравствуйте!

На строке кода vba:
Код
sФ = Split(s, " ", 1)
программа выдаёт ошибку несоответствия типов
При этом s это String, sФ тоже.
Прикладываю принсткрин из отладчика


Почему возникает ошибка?
желаю Вам счастья
Обработчик текста в выделенных ячейках
 
Здравствуйте!

Прикладываю файл с макросом, который запускается после выделения какого-то диапазона ячеек и который призван выполнять разные преобразования текста в этих ячейках. Тестирую я его на первом столбце в диапазоне от A2:А5. Потом если надо повторно протестировать, то копирую туда же из правой колонки.
Первый вопрос о том, почему при выбранной во всплывающей форме галке "Удалить буквы..." удаляются и пробелы? В отладчике видно, что переменная Str пробелы сохраняет, но после команды cell.Value = Str, пробелы в ячейку не вставляются
Второй вопрос, как  починить закомментированную ветку для удаления любого из символов */,.~!@#$%^&(){}\¹;:?-=+'? Сейчас этот код выдает ошибку, invalid pattern, если s = "?"
желаю Вам счастья
Как в макросе вызвать всплывающее окно?
 
Здравствуйте!

Скажите, пожалуйста, как в макросе вызвать(отобразить) всплывающее окно, в котором пользователь должен будет галочками отметить необходимые ему макросы, которые затем будут исполнены после нажатия кнопки ОК?
Изменено: borro - 18 Мар 2019 18:20:24
желаю Вам счастья
Как ускорить открытие файлов в vba?
 
Здравствуйте!

Написал макрос(в  файле "Открытие файлов.xlsm"), который ищет текстовые значения в всех файлах указываемой вручную папки. Столкнулся с тем, что он медленно открывает файлы типа прикладываемого "файл для открытия.xlsx", которых много в папке, на которой отрабатывает макрос.  Каждый типовой "файл для открытия.xlsx"  при открытии как понимаю хочет подтянуть надстройку эксель.
Открываю файлы командой:
Код
Workbooks.Open sPath & objFile.Name, 0, , , , , , , , , , , , , xlNormalLoad
Можно ли каким-то параметром этой команды открывать файлы так, чтобы эта надстройка не подтягивалась. Одним словом, как-то ускорить процесс открытия таких файлов.
желаю Вам счастья
Как получить дату создания файла активной книги вместо даты создания содержимого?
 
Здравствуйте!

Попытался кодом
Код
ActiveWorkbook.BuiltinDocumentProperties("Creation Date")
получить дату создания файла и понял, что это так называемая Дата создания содержимого.

Как же у активной книги получить дату создания файла?
желаю Вам счастья
Как программно подавить предупреждения и ошибки при открытии файла?
 
Здравствуйте!

Открываю файлы методом
Код
Workbooks.Open sPath & objFile.Name, 0, , , , , , , , , , , , , xlRepairFile
но это не помогает в скрытии сообщений, которые вываливаются при открытии прикладываемого файла, который пытается подтянуть файл надстройки-эксель(который допустимо не подтягивать, работая с файлом и без него).

Скажите, можно ли программно из VBA открыть приложенный файл без этих сообщений?
желаю Вам счастья
Вычислить и перемножить два значения, записанные в виде дробей
 
Здравствуйте!

В файле в первых двух столбцах приведены коэффициенты, которые записаны текстом в виде дробей. Скажите, пожалуйста, как можно формулами получить произведение этих двух коэффициентов в третьем столбце? Пример того, что должно получиться стоит в 4-м столбце.
желаю Вам счастья
Упростить логическое выражение (значение в зависимости другой ячейки)
 
Здравствуйте!
В ячейку написал формулу вида:
Код
ЕСЛИ(НЕ(ЕОШ(ПОИСК("Ф-";R248)));"вариант1";"вариант2")
которая должна возвращать разные значения в зависимости от текста проверяемой ячейки. Можно ли как-то укоротить это логическое выражение?
желаю Вам счастья
Ошибка синтаксиса вызова процедуры с опциональным параметром
 
Здравствуйте!

Есть процедура:
Код
Sub issue_a_warning(x As Long, Optional ByVal txt As String = "В строке есть замечания!")
    If ActiveSheet.Cells(x, 2).Interior.Color <> vbRed Then
        ActiveSheet.Cells(x, 2).Interior.Color = vbRed
        ActiveSheet.Cells(x, 2).AddComment
        ActiveSheet.Cells(x, 2).Comment.Text Text:=txt
        ActiveSheet.Cells(x, 2).Comment.Visible = True
        ActiveSheet.Cells(x, 2).Comment.Shape.Select True
        With Selection
            .AutoSize = True
        End With
        ActiveSheet.Cells(x, 2).Comment.Shape.Select False
    End If
End Sub
которая успешно в другой процедуре вызывается как:
Код
issue_a_warning (cell.Row)
и безуспешно(компилятор говорит о синтаксической ошибке) так:
Код
issue_a_warning (cell.Row, "В источнике задвоение!")
В чем причина?
желаю Вам счастья
Поиск полных значений в файлах указанной папки
 
Здравствуйте!

С помощью запускаемого в файле "Тест подхватывания номеров.xlsm" единственного макроса я пытаюсь найти в выбираемой в ходе исполнения макроса папке среди .xls файлов находить  значения, как-либо совпадающие с каждым значением из второго столбца файла с макросом.  Шерстятся все листы и все задействованные диапазоны листов. Найденные значения вставляются справа от искомого значения в файле с макросом.
Вот код макроса:
Код
Sub Найти_полный_sn()
    Dim Путь As String, Файл As String, sn As Range, Совпадений As Integer, i%, rng As Range
    Dim sh As Worksheet
    Dim Книга As Excel.Workbook
    
    'выбираем папку с файлами-источниками информации
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "OK"
        .Title = "Выберите папку, содержащую файлы Excel"
        If .Show = 0 Then
            Exit Sub
        End If
        Путь = .SelectedItems(1)
    End With
    Файл = Dir(PathName:=Путь + "\*.xls")
    i = 2
    Set sn = ActiveSheet.Cells(i, 2)
    
    Do Until sn.Value = "" 'пока не закончатся серийные номера в столбце
       Совпадений = 0
       Do Until Файл = "" 'пока не закончатся файлы в выбранной папке
           Set Книга = Workbooks.Open(Путь + "\" + Файл)
           For Each sh In Книга.Sheets 'поиск по листам
               sh.Activate
               Set rng = sh.UsedRange.Find(What:=sn.Value, LookIn:=xlValues, LookAt:=xlPart)
                If Not (rng Is Nothing) Then
                    Совпадений = 1
                    sn.Offset(0, Совпадений).Value = rng.Value
                    Do Until rng Is Nothing
                        Set rng = sh.UsedRange.FindNext(rng)
                        If Not (rng Is Nothing) Then
                            Совпадений = Совпадений + 1
                            sn.Offset(0, Совпадений).Value = rng.Value
                        End If
                    Loop
                End If
           Next sh
           Книга.Close
           Файл = Dir
       Loop
       i = i + 1
       sn = ActiveSheet.Cells(i, 2).Value 'следующий серийник
    Loop
    Set Книга = Nothing
End Sub
Возникли следующие неточности работы алгоритма, прошу помочь исправить:
1. Как остановить бесконечное зацикливание, возникающее в самом вложенном Do Loop(это поиск значения на отдельном листе)?
2.  Почему-то для первого номера первым находится не короткое значение 60802491, а сразу 23160802491. Почему пропускается первое имеющееся значение

Тестировать макрос можно на втором файле с названием "База с полными номерами.xls", который надо положить в выбираемую в ходе отработки макроса папку.
Изменено: borro - 26 Окт 2018 15:03:10
желаю Вам счастья
Ошибка при обращении к ячейке
 
Здравствуйте!

Есть макрос, который должен работать с активным листом открытого файла:
Код
Sub транспонирование_пирамидаAPI()
    Dim sn As Range, i%, j%
    i = 2
    j = 0
    sn = ActiveSheet.Cells(i, 2)
    Do Until sn.Value = ""
        If Not sn.Characters(1, 1).Font.Bold Then
         j = j + 1
         sn.Offset(1, -j).Value = sn.Value
        Else
          j = 0
        End If
        i = i + 1
        sn = ActiveSheet.Cells(i, 2)
    Loop
End Sub


Он заваливается на строке sn = ActiveSheet.Cells(i, 2) с вываливанием сообщения


В чем ошибка, скажите, пожалуйста.
Изменено: borro - 25 Окт 2018 15:24:41
желаю Вам счастья
Как подтянуть значения по части ключа?
 
Здравствуйте!

В приложенном файле надо проставить столбец ДЗО по совпадению цифровой ненулевой части номера в столбце А со значениями в столбце J. То есть для третьей строки надо брать 4520236 и искать совпадение с ним в столбце J и брать значение справа от найденного совпадения. Ситуация осложняется:
1. Вариативностью мешающей подстроки ADX000000, которая может быть и короче, к примеру ADX000
2. Возможными нулями в начале номеров в столбце J

Как написать этот чудо-ВПР?
желаю Вам счастья
Как правильно добавить еще один элемент двумерного массива?
 
Здравствуйте!

Наполняю двумерный массив v() следующим кодом:
Код
        j = 1
        
        Dim v() As Variant
        For Each MyRow In Range("checked").Rows
            x = MyRow.Row
                If j = 1 Then
                    ReDim v(0, 1 To 4)
                Else
                    ReDim Preserve v(UBound(v, 1) + 1, 1 To 4)
                End If
                v(0, 1) = MyRow.Cells(3).Value & MyRow.Cells(4).Value & MyRow.Cells(9).Value & MyRow.Cells(10).Value
                ' MyRow.Cells(24).Value, MyRow.Cells(25).Value, "")
                v(0, 2) = x 'номер строки
                v(0, 3) = MyRow.Cells(30).Value 'КТТ
                v(0, 4) = ""
                j = j + 1
        Next MyRow
Уже на второй итерации(j=2) код заваливается на строке ReDim Preserve v(UBound(v, 1) + 1, 1 To 4)
Как добавить следующий элемент правильно?
Изменено: borro - 30 Авг 2018 16:39:39
желаю Вам счастья
Табличное представление сводной с повтором подписей и фильтрация расчётов
 
Здравствуйте!

Скажите, пожалуйста, как сводную таблицу в приложенном файле настроить так, чтобы(через логическое И):
1. В каждой строке её было значение столбца А, а не так, как оно показывается - только над всеми входящими в нее значениями из столбца Б
2. Были отфильтрованы все строки со значением в третьем столбце больше 1

То есть в данном случае надо на выходе получить таблицу с тремя столбцами, в которых будут соответственно значения А1, Б1, 3
желаю Вам счастья
Доработка процедуры выделения дублей
 
Здравствуйте!

Попробовал переиначить найденную в интернете процедуру выделения дублей:
Код
Sub SelectDoubles(a As Range)
    Dim q, z As Long
    Dim c, r As Range
        For Each c In a
         If Len(c.Value) > 0 Then
          q = 0
          Set c = a.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                Do
                    If c.Row > q Then q = c.Row
                    Set c = a.FindNext(c)
                    z = c.Row
                    If z > q Then
                        Cells(c.Row, c.Column).Interior.Color = vbMagenta
                        Cells(z, c.Column).Interior.Color = vbMagenta
                    End If
                Loop While c.Row > q
          End If

        Next c
End Sub

Как заставить ее выделять и первое значение из дублирующихся? и ускорить, если возможно
Изменено: borro - 17 Авг 2018 11:09:56
желаю Вам счастья
В чем ошибка в условном операторе?
 
Здравствуйте!

Скажите,  в чем ошибка в этом условном операторе:
Код
            If (geonumbersh = "" Or geonumbersh = "Н/Д" Or geonumberd = "" Or geonumberd = "Н/Д") Then
                geo = 0
            Else
                geo = 1
            End If
?
Изменено: borro - 16 Авг 2018 21:17:54
желаю Вам счастья
Возникает ошибка соответствия типов
 
Здравствуйте!

В теле процедуры вызываю:
Код
    MsgBox (ЕСТЬНД(""))
где ЕСТЬНД это:
Код
Function ЕСТЬНД(s As String)
    If InStr(1, s, "б/н", vbTextCompare) > 0 _
       Or InStr(1, s, "б/у", vbTextCompare) > 0 _
       Or InStr(1, s, "б\н", vbTextCompare) > 0 _
       Or InStr(1, s, "б\у", vbTextCompare) > 0 _
       Or InStr(1, s, "н/д", vbTextCompare) > 0 _
       Or InStr(1, s, "н\д", vbTextCompare) > 0 _
       Or InStr(1, s, "нет", vbTextCompare) > 0 Then
       ЕСТЬНД = 1
    Else
        ЕСТЬНД = 0
    End If
End Function
Это возвращает ошибку type mismatch

Скажите, пожалуйста, почему ошибка и как исправить ЕСТЬНД?
Изменено: borro - 16 Авг 2018 20:11:57
желаю Вам счастья
Что замедляет открытие и сохранение файла?
 
Здравствуйте!

Файл относительно небольшой, 2.8Мб. Как узнать, что тормозит его открытие и сохранение, и как это потом устранить, сохранив данные единственного нескрытого листа?
желаю Вам счастья
Как вставить значения столбца с одного листа на другой?
 
Здравствуйте

Скажите, пожалуйста, каким должен быть VB код, который бы в приложенной книге, копировал все значения столбца "Центр питания"(за исключением заголовка) листа Каскад" на новый создаваемый лист в ячейку с координатами X,Y?
желаю Вам счастья
Страницы: 1 2 След.
Наверх