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

Страницы: 1 2 3 4 5 6 7 След.
Копировать несколько листов в новые книги с присвоением имен
 
Всем привет! Пытаюсь перебрать несколько листов, скопировать их в новые книги и присвоить книгам имена этих листов.
Перебор работает на других задачах, с этим все хорошо. Проблема только с созданием книги и присвоением имени.
Код
Dim WsAr, i&    
WsAr = Array("СФ", "ЮФ", "МФ")
    For i = LBound(WsAr) To UBound(WsAr)
        With Worksheets(WsAr(i))
            iPath = ActiveWorkbook.Path
            newbookname = .Name
           'Сюда нужно вставить операцию по созданию новой книги с присвоением ей имени переменной newbookname
           'и сохранять ее в iPath (папка с исходной книгой)
        End With
    Next
Изменено: IvanMantrov - 1 Авг 2019 16:54:00
Перебор файлов в папках
 
Спасибо!!! Оба варианта классные!
Перебор файлов в папках
 
Всем привет! Раньше для работы сразу с несколькими файлами (копирование, редактирование и т.д.) в одной папке использовал такой код:
Код
Dim abook As Workbook
    Set abook = ActiveWorkbook
    Dim daway As String, item As String
    Dim somebook As Excel.Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "OK"
        .Title = "Выбери папку с файлами, которые надо перебрать"
        If .Show = 0 Then
            Exit Sub
        End If
        daway = .SelectedItems(1)
    End With
    item = Dir(PathName:=daway + "\*.xls*")
    Do Until item = ""
        Set somebook = Workbooks.Open(daway + "\" + item)
        'Действия с книгой
        somebook.Close
        item = Dir
    Loop
    Set somebook = Nothing

Теперь условия изменились. В целевой папке содержатся не файлы, а много папок, в каждой из которых несколько файлов, которые надо обработать. Т.е. надо перебирать папки, а потом уже файлы внутри. Вложенный цикл должен получиться. Что-то вроде for each %переменная, обозначающая папку% in daway
Помогите пожалуйста его организовать.
Доступ к части кода определенному кругу пользователей
 
Sanja,ОГОНЬ! Спасибо, работает. Не все понятно н.с. кода, но разберусь
Доступ к части кода определенному кругу пользователей
 
Цитата
IvanMantrov написал:
If slov.exists("323") Then
Т.е. тут идет проверка одного элемента? "323". А как вместо него имя компьютера подставить. Неважно какое, просто чтобы он сравнил его со списком
Доступ к части кода определенному кругу пользователей
 
skais675,Спасибо, попробую!
Доступ к части кода определенному кругу пользователей
 
Всем привет!
При написании макросов иногда выделяю отдельно операции, которые будут выполняться только на моем компьютере, например так:
Код
    Dim objNetwork As Object
    Set objNetwork = CreateObject("WScript.Network")
    ComputerName = objNetwork.ComputerName
    Set objNetwork = Nothing
    If ComputerName Like "IMANTROV-NB" Then
        'Операции для меня    
    else        
        'Операции для других пользователей
    End If

А что если нужно дать доступ нескольким пользователям. Как сформировать небольшой список из имен (4-5 шт.) и сравнивать имя пользователя с этим списком?
Изменено: IvanMantrov - 28 Июн 2019 10:31:07
Произвольное количество символов в ячейке
 
Wild.Godlike,В моем случае эти символы там будут в любом случае, но спасибо, это важное уточнение!
Произвольное количество символов в ячейке
 
А ведь верно, правсимв и левсимв можно соеденить через "И":

=ЕСЛИ(И(ЛЕВСИМВ(A1;2)<>"ВИ";ПРАВСИМВ(A1;2)<>"ВИ");1;2)
Изменено: IvanMantrov - 25 Июн 2019 08:36:41
Произвольное количество символов в ячейке
 
artyrH,ой, точно! ошибся! НЕ в начале и НЕ в конце
Произвольное количество символов в ячейке
 
Цитата
Wild.Godlike написал:
Ищет ВИ в ячейке,
Не совсем! Тут надо именно находить ячейки, в которых "ВИ" стоит не в начале и не в середине, а между какими-то другими числами или буквами
Произвольное количество символов в ячейке
 
Nordheim, можно, но если значение начинается с чего-то или чем-то заканчивается. А если так: *АБВ*? Т.е. критерий в середине?
Произвольное количество символов в ячейке
 
Доброго всем дня!
Как в функции ЕСЛИ задать в качестве критерия значения наподобие *АБВ, где звездочка - это любое количество любых символов.
В макросах и поиске это делается именно так, но в формулу вставить не выходит:

=ЕСЛИ(A1="*ВИ";1;0)

Цикл при переборе пропускает часть элементов
 
Ігор Гончаренко,Спасибо!
Цикл при переборе пропускает часть элементов
 
БМВ,Спасибо! Дело в смещении столбцов после удаления, да?
Цикл при переборе пропускает часть элементов
 
Доброго всем дня!
Цикл по идее должен удалять колонки, с определенными заголовками. Но по факту всегда остается несколько, хотя они удовлетворяют условиям. Полностью все удаляется только при повторном запуске макроса. Конкретно в файле примера должны удаляться вообще все колонки, но этого не происходит
Код
For cl = 1 To .UsedRange.Columns.Count
      If .Cells(1, cl).Value Like "Скидка*" Then .Cells(1, cl).EntireColumn.Delete
      If .Cells(1, cl).Value Like "*999*" Then .Cells(1, cl).EntireColumn.Delete
Next
Копирование данных из книг с определенным названием
 
Ігор Гончаренко,Спасибо!!! Похоже я все усложнил. Действительно, все гораздо проще можно сделать!
Копирование данных из книг с определенным названием
 
Добрый день!
Пытаюсь перебрать файлы в папке и копировать данные только из тех, чье имя содержит "20", например.
Код
Dim abook As Workbook
    Set abook = ActiveWorkbook
    Dim fileway As String, Objct As String
    Dim xlfile As Excel.Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "OK"
        .Title = "Выбери папку"
        If .Show = 0 Then
            Exit Sub
        End If
        fileway = .SelectedItems(1)
    End With
    Objct = Dir(PathName:=fileway + "\*.xlsx")
    Do Until Objct = ""
        Set xlfile = Workbooks(fileway + "\" + Objct)
        nm = xlfile.Name
        If nm Like "*20*.xlsx*" Then
            lrg = abook.Sheets("Svod").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("List1").Select
            [A1].Copy abook.Sheets("Svod").Cells(lrg + 1, 1)
        End If
        xlfile.Close
        Objct = Dir
    Loop
    Set xlfile = Nothing

Вот тут:
Код
Set xlfile = Workbooks(fileway + "\" + Objct)
возникает ошибка Subscript out of range
Можно конечно сделать так:
Код
Set xlfile = Workbooks.Open(fileway + "\" + Objct)
все работает, но макрос открывает по очереди все книги, а это долго.
Подскажите, пожалуйста какой метод использовать вместо Open
Автофильтр с критериями - указанием первых букв значений
 
Jack Famous,так не прокатит. Я пробовал, но таким методом можно только два критерия использовать
Автофильтр с критериями - указанием первых букв значений
 
RAN,Спасибо!
Автофильтр с критериями - указанием первых букв значений
 
JayBhagavan,вот он!
Автофильтр с критериями - указанием первых букв значений
 
Всем доброго дня!
При фильтрации с темя критериями вот так
Код
.[A:Q].AutoFilter Field:=4, Criteria1:=Array("A", "B", "C"), Operator:=xlFilterValues
или вот так:
Код
.[A:Q].AutoFilter Field:=1, Criteria1:="abc*"
все получается. Первый фильтр использует сразу три критерия, а второй отображает значения, начинающиеся с определенных букв. Но если попытаться таким же методом действовать в первом случае (в каждом критерии указать только начало значения ячейки), то фильтр не работает.
Код
.[A:Q].AutoFilter Field:=4, Criteria1:=Array("A*", "B*", "C*"), Operator:=xlFilterValues
Вернее работает, но скрывает все.
Потеря знаков при приобразовании текста в число
 
Казанский,Спасибо! Второй вариант подходит!
Потеря знаков при приобразовании текста в число
 
Nordheim, в процессе обработки макросом колонка копируется на другой лист и сразу же теряются эти три знака. Т.е. с ней нельзя ничего сделать. Смотреть можно, трогать нельзя.
Потеря знаков при приобразовании текста в число
 
Доброго всем дня!
При экспорте данных в Excel источник выдает одну из колонок в которой содержатся только числа (кроме заголовка) в текстовом формате.
Пример: 121000011507605455
При попытке преобразовать в число результат получается такой: 121000011507605000
Последние три знака превращаются в нули! Почему так происходит и как с этим бороться?
Ошибка при фильтрации по датам
 
Спасибо! Значит просто расширить диапазон нужно, фильтруемый.
Ошибка при фильтрации по датам
 
gling,точно не поэтому
.Range("A:X").AutoFilter - это добавляет фильтр, независимо от того был он там или нет
Например, если его убрать с листа Расхождения2, то он будет добавлен автоматически.
С другой стороны, если заранее включить фильтр на первом листе, то все работает.
Тогда возникает вопрос: почему на один лист фильтр добавляется, а на другой тем же самым кодом - не хочет???
Ошибка при фильтрации по датам
 
В качестве критериев фильтрации использую значения ячеек с другого листа:
Код
With Sheets("Расхождения")
    datapi = Sheets("Макрос").Range("B3") - 1
    datai = Sheets("Макрос").Range("F5")
    For u = 1 To .UsedRange.Columns.Count
        If .Cells(1, u).Value Like "Дата учета" Then
            .Range("A:X").AutoFilter Field:=u, Criteria1:= _
            "<=" & CDbl(CDate(datapi)), Operator:=xlAnd, Criteria2:=">=" & CDbl(CDate(datai))
        End If
    Next
    End With
При попытке фильтрации выдает ошибку. Обычно этот метод работает. В этом можно убедиться если в файле-примере поменять в коде "Расхождения" на "Расхождения 2". На листе "Расхождения 2" схожие данные. При этом ошибки там не возникает.
Ошибка при копировании видимых ячеек после фильтрации
 
Все способы работают, спасибо!!!
Ошибка при копировании видимых ячеек после фильтрации
 
Цитата
Nordheim написал:
Это что
Определяет количество видимых ячеек
Страницы: 1 2 3 4 5 6 7 След.
Наверх