Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
Как обезопаситься от вирусов в Excel?
 
Дмитрий(The_Prist) Щербаков, Jack Famous, спасибо за ответ, поняла)
Изменено: Maayun - 22.02.2022 22:08:19
Как обезопаситься от вирусов в Excel?
 
Привет! Расскажите, пожалуйста, как не нарваться на вирусы в файлах excel, например, с форума, делаете ли вы что-то, чтобы себя обезопасить, встречали ли их?  
Исправление ошибки "Столбец не найден" при обновлении запроса в Power Query.
 
В примере ничего не видно, подключение к вашему шерпойнту, уберите из запроса жёстко заданные шаги, например поищите на ютуб как развернуть всё столбцы.
если ругается, значит действительно столбца нет или поменялось его название
Если при фильтрации данных нет, перейти к следующей переменной
 
Иван Манченко, спасибо, хорошая идея, реализовала  :)
От себя добавлю, что при переходе на другой лист массив нужно чистить
Изменено: Maayun - 30.01.2022 19:39:50 (исчезло обращение)
Если при фильтрации данных нет, перейти к следующей переменной
 
Добрый день, уважаемые формучане.
Прошу подсказать, есть макрос, который перебирает значения из диапазона и вставляет их как значение фильтра в другие листы. Но не во всех листах есть подходящие значения и при фильтрации ничего не выдает, но макрос всё равно обрабатывает пустой диапазон и шапку и переносит на след. лист.

Пример прилагаю, в городе Самара нет Сидорова, в Пензе нет Иванова, а на выходе всё равно получается Сидоров_, Иванов_
Код
Sub Splitter()

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 
 Dim h As Integer
 Dim wrksht As Worksheet
 Dim oListObj As ListObject

       For h = 2 To Sheets.Count
       Set wrksht = ActiveWorkbook.Worksheets(h)
       
       Set oListObj = wrksht.ListObjects(1)
 
        For Each cell In Range("ФИО")
        Sheets(wrksht.Name).Select
        FinalCol = Cells(1, Application.Columns.Count).End(xlToLeft).Column
        FinalRow = Cells(Application.Rows.Count, 1).End(xlUp).Row
        
        Range(oListObj.Name).AutoFilter Field:=FinalCol, Criteria1:=cell.Value

        Range(Cells(1, 1), Cells(FinalRow, FinalCol)).SpecialCells(xlCellTypeVisible).Copy
        ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
        ActiveSheet.Paste
        ActiveSheet.Name = cell.Value & "_" & Cells(2, FinalCol - 1).Value
        ActiveSheet.UsedRange.Columns.AutoFit
        Next cell
        Next

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
End Sub
Окна Power Query отображаются со сдвигом
 
 с такой проблемой не сталкивалась. а есть возможность за шапку утащить правее, в видимую область?
PQ. Поиск файла-исходника по части названия файла, Параметризация путей к данным в Power Query
 
Михаил Л, теперь работает. Спасибо!
PQ. Поиск файла-исходника по части названия файла, Параметризация путей к данным в Power Query
 
Михаил Л, можно ли сделать этот путь определяемым автоматически?
Код
Source = Folder.Files("D:\S\Проверка")  

Добавила в FilePath новую ссылку со словом База - Jan' База и База региона - не видит никакие из них. Это к слову, если придётся добавлять отчёты.

Причём сами отчеты приходится приводить к нужному виду, это можно вставить между шагами, наклацав самому?  :oops:

PQ. Поиск файла-исходника по части названия файла, Параметризация путей к данным в Power Query
 
Добрый вечер!
Есть еженедельные отчёты, например, Feb' Отчет и Dashboard 01.03.2020. В первом меняется месяц выпуска, во втором - дата. Настроена параметризация путей к данным в Power Query, но я каждый раз убираю переменные в названии, оставляю только Отчёт и Dashboard. Подскажите, пожалуйста, можно ли настроить, чтобы формула в ячейке искала определенные слова (*Отчёт.xlsx и Dashboard*.xlsx) в названии файла и не приходилось каждый раз переменные удалять?

Понимаю, что вопрос не сколько к PQ, сколько к формулам Excel.
Сохранить вкладки книги в отдельные файлы, разорвать связи с PQ и выложить по ссылке
 

Оставлю здесь свой макрос, он сохраняет выделенные листы в отдельные файлы и создаёт зип-архив с ними

Код
Sub CreateNewZip(sPath As String)
    If Dir(sPath) <> "" Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub


Sub расслитовка()
Dim s As Worksheet
Dim wb As Workbook
Dim pQuery As WorkbookQuery
Dim aw As Window
Set wb = ActiveWorkbook
Set aw = ActiveWindow
For Each s In aw.SelectedSheets
Set tempwindow = aw.NewWindow
Application.ScreenUpdating = False
s.Copy
For Each pQuery In ActiveWorkbook.Queries
        pQuery.Delete
Next
tempwindow.Close
Application.DisplayAlerts = False
Dim full_path As String
Dim folder_path As String
folder_path = wb.Path & "\" & "База региона " & s.Name & " " & Date & ".zip"
full_path = wb.Path & "\" & "База региона " & s.Name & " " & Date & ".xlsx"
ActiveWorkbook.SaveAs full_path


Call ZIPOneFile(folder_path, full_path)
ActiveWorkbook.Close


Application.DisplayAlerts = True
Next
Application.ScreenUpdating = True
End Sub


 
Function ZIPOneFile(sZIPFileName As String, sFileToZIP As String)
    Dim objShell As Object
    Dim lcnt As Long
 
    Set objShell = CreateObject("Shell.Application")
    'создаем пустой ZIP-архив, если его еще нет
    If Dir(sZIPFileName, 16) = "" Then
        CreateNewZip (sZIPFileName)
    End If
    lcnt = objShell.Namespace((sZIPFileName)).Items.Count
    'помещаем файлы из папки в архив
    objShell.Namespace((sZIPFileName)).CopyHere CStr(sFileToZIP)
    'дожидаемся окончания архивации
    Do Until objShell.Namespace((sZIPFileName)).Items.Count = lcnt + 1
        DoEvents
    Loop
End Function

Изменено: Maayun - 28.02.2020 23:10:48
Вставка динамической связи с другим листом.
 
Добрый вечер.
Динамический массив с ссылкой на форматированную таблицу, тогда при изменении исходной таблицы, будет меняться сам массив.
Почитайте у Николая Павлова про динамические массивы.
Динамический расчёт даты для фильтра в PQ
 
buchlotnik,то, что надо) спасибо.
PooHkrd, спасибо за замечание, действительно недоставало одной скобки)
Динамический расчёт даты для фильтра в PQ
 
Добрый день!

Требуется отсечь истёкшие договоры. Подскажите, пожалуйста, как сделать фильтр в PQ динамическим, когда ставишь фильтр "после" и кнопку "сегодня", получается конкретная дата:
Код
= Table.SelectRows(#"Измененный тип", each [Дата окончания контракта] > #date(2020, 1, 16))
Группировка строк в одну с помощью Power Query
 
Андрей VG, спасибо, код - то, что надо.

А вот PP ни разу не пользовалась, попробую завтра сформировать сводную с его помощью.
Группировка строк в одну с помощью Power Query
 
Андрей VG, не получается, как у вас. Не подскажете, в чём проблема, как вместо количества вывести значения условий платежа и описаний условий платежа.

И это просто сводная, в реале я объединяю информацию с помощью PQ из нескольких файлов, хотелось бы понять как сгруппировать строки с одинаковыми ИД в одну, и использовать в дальнейших объединениях.
Группировка строк в одну с помощью Power Query
 
Добрый вечер!

Прошу подсказать решение: имеется таблица с ИД клиента, условием платежа и описанием условия платежа. Из-за того, что у одного клиента могут быть разные условия платежа, ИД клиента в таблице повторяется по нескольку раз. Можно ли сгруппировать имеющиеся условия платежа и описания условия платежа в одну строку через слэш по ИД клиента, чтобы исключить повторения?
Как работать с копией листа?, Требуется скопировать лист в новую книгу, зазначить, сохранить и закрыть
 
Ігор Гончаренко, я всё прекрасно понимаю, но в том то и дело, что мне нужно было знать не как совершить эти действия, а как обратиться к объекту, который получается в результате работы продедуры sheets.copy. Как только узнала, получился тот макрос, который я хотела. Оставлю здесь, как сохранить выбранные листы с определённым названием в отдельные книги с последующим их закрытием.

Код
Sub primer()
Dim s As Worksheet
Dim iPath As String

  iPath = ThisWorkbook.Path
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
      Dim AW As Window
    Set AW = ActiveWindow
    For Each s In AW.SelectedSheets
        Set TempWindow = AW.NewWindow
        s.Copy
     ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
     ActiveWorkbook.SaveAs iPath & "\" & Range("B3") & Range("B2") & ActiveSheet.Name & ".xls", FileFormat:=56
     ActiveWorkbook.Close
      TempWindow.Close
     Next
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
Как работать с копией листа?, Требуется скопировать лист в новую книгу, зазначить, сохранить и закрыть
 
Прошу прощения за корявое ТЗ, не знала, что когда создаётся копия листа, это фактически книга.
Kuzmich, спасибо, то что,надо.
Путаница вызвана тем, что изначально меня просили, чтобы книга целиком сохранялась с названием текущего листа, значения вместо формул и удалялись остальные листы, потому что если вынести в новую книгу сразу конкретный лист, программа не принимает этот формат.
Как работать с копией листа?, Требуется скопировать лист в новую книгу, зазначить, сохранить и закрыть
 
Kuzmich, а нельзя ли прописать то, с каким именем этот лист будет сохраняться?
Как работать с копией листа?, Требуется скопировать лист в новую книгу, зазначить, сохранить и закрыть
 
БМВ,так точно, перевести в значения, модный и молодёжный слэнг - "зазначить"
Как работать с копией листа?, Требуется скопировать лист в новую книгу, зазначить, сохранить и закрыть
 
Добрый вечер, форумчане.
Подскажите, как совершать манипуляции с копией листа?
Пока получается только задействовать активную книгу, что не есть хорошо, она должна оставаться целой, как шаблон.
Нужно вынести лист в отдельную книгу, зазначить сумму, сохранить и закрыть.
Пример прилагаю.
Код
Sub RandW()
Dim wb As Workbook
Dim s As Worksheet
Dim AW As Window
Set wb = ActiveWorkbook
Set AW = ActiveWindow
Application.DisplayAlerts = False
'преобразование формул в значения на текущем листе
  ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
 On Error Resume Next
 
  For Each s In Sheets
    If Not s Is ActiveSheet Then s.Visible = xlSheetVisible: s.Delete
  Next
 ' Application.Quit
ActiveWorkbook.SaveCopyAs wb.Path & "\" & Range("B1") & Range("B2") & ActiveSheet.Name & ".xls"

  Application.DisplayAlerts = True
End Sub
Вставка таблицы в письмо Outlook без форматирования
 
Nordheim,шикарно, то, что надо.
Спасибо)
Вставка таблицы в письмо Outlook без форматирования
 

Не помогло. Если вставить таблицу в файл Дмитрия - работает, а если скопировать его код к себе - нет.

Текст макроса привожу ниже:

Код
Option Explicit
 
Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = "AddressTo@mail.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = Range("AF4")    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Странно, что не отображается " & Range("B9") & "\Microsoft\Signatures\"
Dim sTblBody As String
sTblBody = ConvertRngToHTM(Selection)
     'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "C:\Temp\Книга1.xls"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
 
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody  'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        .Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
        '.Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
        .Display
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
Function ConvertRngToHTM(rng As Range)
    Dim fso As Object, ts As Object
    Dim sF As String, resHTM As String
    Dim wbTmp As Workbook
 
    sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'переносим указанный диапазон в новую книгу
    rng.Copy
    Set wbTmp = Workbooks.Add(1)
    With wbTmp.Sheets(1)
        'вставляем только ширину столбцов, значения и форматы
        .Cells(1).PasteSpecial xlPasteColumnWidths
        .Cells(1).PasteSpecial xlPasteValues
        .Cells(1).PasteSpecial xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        'удаляем все объекты(фигуры, рисунки и пр.)
        '------------------------------------------
        'если рисунки и объекты нужны - удалить этот блок
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
        '------------------------------------------
    End With
    'сохраняем книгу как Веб-страницу(чтобы содержимое конвертировать в HTML-код)
    With wbTmp.PublishObjects.Add( _
         SourceType:=xlSourceRange, Filename:=sF, _
         Sheet:=wbTmp.Sheets(1).Name, Source:=wbTmp.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'открываем созданный файл как текстовый и считываем содержимое
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)
    resHTM = ts.ReadAll
    ts.Close
    'выравниваем таблицу по левому краю(если надо оставить по центру - удалить эту строку)
    ConvertRngToHTM = Replace(resHTM, "align=center x:publishsource=", "align=left x:publishsource=")
    'закрываем временную книгу и удаляем
    wbTmp.Close False
    Kill sF
    'очищаем объектные переменные
    Set ts = Nothing: Set fso = Nothing
    Set wbTmp = Nothing
End Function


Изменено: Maayun - 15.10.2019 22:27:12
Вставка таблицы в письмо Outlook без форматирования
 
Добрый вечер, форумчане.
Взяла код Дмитрия (The_Prist) для формирования письма Outlook с таблицей из Excel и в этом месте случился затык - не происходит ничего.
Вроде бы и макросе прописала нужный диапазон, и в функции, а таблица не вставляется. Нужна вставка в письмо диапазона A4:B11

*PS и подпись меня подводит, подпись, как ты могла?
Сохранить вкладки книги в отдельные файлы, разорвать связи с PQ и выложить по ссылке
 
Дмитрий, выделяет NewZip - "Sub of Function not defined"
Сохранить вкладки книги в отдельные файлы, разорвать связи с PQ и выложить по ссылке
 
Дмитрий, в основном файле несколько листов, я хочу, чтобы после обновления данных с помощью PQ, эти листы выносились в отдельные книги, рвались связи с PQ и выгружались на ресурс. Необязательно даже архивировать, нужно, чтобы конечные пользователи не могли вносить изменения в книгу - максимум - фильтрация.

Код не смогла опробовать - на NewZip, опять упирается в то,что Excel 2013?  
Сохранить вкладки книги в отдельные файлы, разорвать связи с PQ и выложить по ссылке
 
Юрий М,  :D ой, что-то я по аналогии с браузером называю. Конечно, листы имею в виду :oops:  
Сохранить вкладки книги в отдельные файлы, разорвать связи с PQ и выложить по ссылке
 
Дмитрий, спасибо - пофиксила.
Подскажите, можно ли задать название архива, исходя из названия вкладки: в моем основном файле их несколько,макросом выношу в отдельные файлы и надо,чтобы они заархивировались согласно названия вкладки.
Сохранить вкладки книги в отдельные файлы, разорвать связи с PQ и выложить по ссылке
 
ctacon, всё верно - работает.
Не подскажете, как быть с архивацией и выкладкой по заданному пути? в текущем макросе архивирует, но при открытии архива ругается, что формат файла не соответствует его разрешению
Сохранить вкладки книги в отдельные файлы, разорвать связи с PQ и выложить по ссылке
 
Андрей VG, если запускать с
Код
ActiveWorkbook.Queries("Тест").Delete

то ошибка "Объект не поддерживает этот метод" и выделяют всю строку жёлтым.

Если ваш вариант, то "User-defined type not defined".

Зависит от версии Excel? У меня 2013

Страницы: 1 2 След.
Наверх