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

Страницы: 1 2 3 След.
Простой макрос на создание файлов по фильтру
 
Ігор Гончаренко,  Спасибо, действительно был лишний пробел.
А можно копировать листы с формулами, а не просто как значение?
Изменено: zhekachan - 13.02.2023 12:19:10
Сохранение файлов по фильтре с первым рядком
 
Пробачте, затупив!
Прохання видалити тему
Сохранение файлов по фильтре с первым рядком
 
Всем добрый день!

Недавно я взял с вашего форума классный скрипт, который фильтрует один файл по колонке и на основе фильтрации создает несколько файлов и сохраняет их. Как к этому скрипту добавить чтобы он в каждый файл вставлял первую строчку с основного файла в каждый следующий (отфильтрованный файл)
Код
Option Explicit
 
Sub copyu()
    Dim oDic As Object, oFSO As Object
    Dim arrData(), arrSeparateItems(), arrTemp()
    Dim TempWb As Workbook
    Dim sFolderPath As String, sFullFileName As String
    Dim LastRow As Long, i As Long, n As Long, c As Long, r As Long
 
    If MsgBox(?????", vbQuestion + vbYesNo, "Разбивка") = vbNo Then Exit Sub
     
    
    sFolderPath = "https://mhpo365.sharepoint.com"
  
   
    If sFolderPath = vbNullString Then Exit Sub
    If Right(sFolderPath, 1) <> Application.PathSeparator Then sFolderPath = sFolderPath & Application.PathSeparator
           
    Application.ScreenUpdating = False
     
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oDic = CreateObject("Scripting.Dictionary")
     
    With ActiveSheet
        If .FilterMode = True Then .ShowAllData
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        arrData = .Range("A2:AB" & LastRow).Value
    End With
     
    For i = 1 To UBound(arrData)
        If Not oDic.Exists(arrData(i, 1)) Then oDic.Add arrData(i, 1), 0&
    Next i
    arrSeparateItems() = oDic.Keys
     
    For n = LBound(arrSeparateItems) To UBound(arrSeparateItems)
        ReDim arrTemp(1 To UBound(arrData), 1 To UBound(arrData, 2))
        r = 0
        For i = LBound(arrData) To UBound(arrData)
            If arrData(i, 1) = arrSeparateItems(n) Then
                r = r + 1
                For c = LBound(arrData, 2) To UBound(arrData, 2)
                    arrTemp(r, c) = arrData(i, c)
                Next c
            End If
        Next i
         
        Set TempWb = Workbooks.Add
        With TempWb.Worksheets(1)
            .Range("A1").Resize(1, UBound(arrData, 2)).Value = arrData
            .Range("A2").Resize(UBound(arrTemp), UBound(arrTemp, 2)).Value = arrTemp
            .Columns("A:Z").AutoFit
        End With
         
        sFullFileName = sFolderPath & arrSeparateItems(n) & ".xlsx"
        If oFSO.FileExists(sFullFileName) Then oFSO.Deletefile (sFullFileName)
        TempWb.SaveAs sFullFileName, FileFormat:=51 'XLSX
        TempWb.Close SaveChanges:=False
    Next n
     
    Application.ScreenUpdating = True
    MsgBox "???? " & sFolderPath, vbInformation
End Sub


Изменено: zhekachan - 13.02.2023 11:24:59
Простой макрос на создание файлов по фильтру
 
Добрый день, подскажите почему у меня вылетает ошибка:

Method saveas of object _ workbook failed

Брал код со второго сообщения

Спасибо!
Изменено: zhekachan - 30.01.2023 17:27:31
Печать нескольких вкладок Excel в один файл PDF, При выводе на печать в PDF файл 4 вкладки Excel печать разделяется на 2 файла
 
Всем дорый день,
Попробуйте через Shift выбрать нужные страницы, а потом через Ctrl+P печатать, у меня работает.
Если ячейка содержит одно, то отображается следующее, если ячейка содержит другой текст, то отображается второе и т.д., Формула
 
SevenZZ, как вариант если вам хочеться через ЕСЛИ:
Если ячейка содержит одно, то отображается следующее, если ячейка содержит другой текст, то отображается второе и т.д., Формула
 
SevenZZ,Изменил свою формулу, так хорошо?
Если ячейка содержит одно, то отображается следующее, если ячейка содержит другой текст, то отображается второе и т.д., Формула
 
SevenZZ, Добрый день,
Я решил проблему с дополнительной таблицей.
Подойдет?
Суммирование ячеек с числовыми и текстовыми значениями
 
Андрей-1821,Так?
Суммирование ячеек с числовыми и текстовыми значениями
 
Добрый день,
Вы так хотели?
Формула Если с ошибкой
 
БМВ, Полностью с вами согласен!

Хотел написать ответ с кодом:
Код
=ЕСЛИ(ОКРУГЛ(F3;2)*100<30;"C";
ЕСЛИ(И(ОКРУГЛ(F3;2)*100>=31;ОКРУГЛ(F3;2)*100<=60);"B";
ЕСЛИ(И(ОКРУГЛ(F3;2)*100>=61;ОКРУГЛ(F3;2)*100<=100);"A";
)))
Но и там нормально полдучилось!

А тему можно назвать: "Округление в формуле Если"
Формула Если с ошибкой
 
[CODE][/CODE]
Изменено: zhekachan - 22.11.2019 12:47:37
Как написать на языке запросов DAX функцию суммесли
 
Valtron85, если очень грубо говорить,
то можно использовать calculate & filter:
Код
Measure = Calculate (sum ([колонка которую суммируем]);Filter([таблица в которой суммируешь];[поле в котором пишешь фильтр]))
Пример из моего опыта:
Код
Measure = calculate(sum('budget'[RISK]);filter('budget';'budget'[YEAR]="2019"))
Как-то так...
Но опять же это только один вариант из многих!
Изменено: zhekachan - 20.11.2019 18:47:45
выделение e-mail из текста ячейки
 
yurisl,Привет, тебе не нужны формулы, это csv файл!
А комы там это разделители, нажми на кнопку "текст по столбцам" и раздели с разделителем кома.
Вот и все)
Подсчет транзакций у ID
 
Sentinal,в кололне С1 - день
Код
=IF(COUNTIFS(Лист2!E:E;"Покупка";Лист2!D:D;Лист1!$C$1;Лист2!B:B;Лист1!A2)>=2; "YES"; "NO")
Сумма за все прошедшие месяцы с начала года
 
Lelya7, Добрый день,
Надеюсь я правильно понял задачу?
VBA не удаеться сохранить ярлык
 
Добрый день!

У некоторых пользователей возникла ошибка:  (run time error -2147467259 (80004005)) не удаеться сохранить ярлык.
Можете подсказать в чем ошибка?
Код макроса:
Код
Private Sub Workbook_Open()
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    Dim strDesktop As String
    strDesktop = WshShell.SpecialFolders("Desktop")
    Dim oShellLink As Object
    Set oShellLink = WshShell.CreateShortcut(strDesktop & "\A.I.D.A.lnk")
    oShellLink.TargetPath = "https://apps.powerapps.com/"
    oShellLink.WindowStyle = 1

    oShellLink.IconLocation = "G:\"
    oShellLink.Description = "The best app in the world"
    oShellLink.WorkingDirectory = strDesktop
  
    oShellLink.Save
    Dim a As Integer
    a = MsgBox("Поздравляю, на вашем рабочем столе появился значек A.I.D.A" & vbNewLine & "Приятного использования!", 64)
UserForm1.Show
End Sub
Изменено: zhekachan - 05.11.2019 14:48:38
Копировать картинку из вложения и вставить на рабочий стол
 
Добрый день!

Помогите с задачей:
Приходит письмо с картинкой формата .ico и ексель файл, в ескселе макрос который скопирует картинку из вложения и вставит на рабочий стол.
Мне в голову ничего не приходит(
Жду вашей помощи!
Создать ярлык на рабочем столе с картинкой и ссылкой на сайт с помощью VBA
 
БМВ,спасибо большое!
Создать ярлык на рабочем столе с картинкой и ссылкой на сайт с помощью VBA
 
БМВ, добрый день,
Смолтрите есть такой код:
Код
Sub CreateDesktopShortcutWithIcon()
    
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    Dim strDesktop As String
    strDesktop = WshShell.SpecialFolders("Desktop")
    Dim oShellLink As Object
    Set oShellLink = WshShell.CreateShortcut(strDesktop & "\название.lnk")
    oShellLink.TargetPath = "ссылка"
    oShellLink.WindowStyle = 1
    
    oShellLink.IconLocation = "C:\__tmp\MIME\foo.ico"  '
    oShellLink.Description = "THE BEST OF THE BEST"
    oShellLink.WorkingDirectory = strDesktop
  
    oShellLink.Save
End Sub
Сможете подсказать где тут ссылка на картинку файла, так же можете подскажете как подставить туда свою картинку!
Буду очень благодарен!
Создать ярлык на рабочем столе с картинкой и ссылкой на сайт с помощью VBA
 
Всем добрый день!

Может кто-то знает или может помочь как мне создать ярлык на рабочем столе с ссылкой внутри и с правильной картинкой с помощью VBA.
Создаеться для удобства пользователя!
Картинка ярлыка должна меняться на нужную, в данном примере можно использовать лубую!
Ссылка должна быть на гугл форму но для удобства можно встасить ссылку на этот форум (https://www.planetaexcel.ru/forum/)

Всем спасибо за отзыв!
Необычная подстановка значений. Сверка столбцов
 
BobbyJo,
Добрый день!
Попробуйте такую фомулу:
Код
=INDEX(Из!A:M;MATCH(В!A2;Из!A:A;0);MATCH(В!B2;Из!$1:$1;0))
Замена части текста с разбросом названий по ячейкам
 
Alex444,
У меня такой пример:
Код
=MID(D2;FIND(C2;D2)+LEN(C2);LEN(D2)-LEN(C2))

Замена части текста с разбросом названий по ячейкам
 
Alex444,Тогда можете использовать формулу MID с сочитанием формулы FIND.
Это как один из вариантов решения!
Соединение двух таблиц с повторяющимся значениями
 
Alex444,Добрый день,
а какой порядок описание, всегда сначала идет год, потом цвет, а потом структура?
Замена части текста с разбросом названий по ячейкам
 
Alex444, Добрый день,
а какой порядок описание, всегда сначала идет год, потом цвет, а потом структура?
Убрать одну колонку из Totals в power bi
 
Добрый день,
Столкнулся с проблемой, не могу придумать как убать из total в матрице одну колонку, что-бы тотал по ней не считался!
Помогите с проблемой)
Вставка символов кодом vba
 
Андрей VG,Спасибо огромное!
Всем хорошего дня!
Вставка символов кодом vba
 
Всем добрый день,
Прошу помочь с вопросом, не могу найти как вставить символ South West Arrow (2199) кодом vba.

Сам код такой:
Код
IF(RC[5]>=1,""уменьшение XXX на ""&TEXT(RC[5],0)&"" млн долл"","""")
Хочу вместо слова уменьшение вставить символ.

Заранее спасибо за помощь!
Поиск суммы по коду (вертикаль) и счету (горизонталь), ошибка в формуле подсчета по нескольким условиям
 
ОксанаD, Добрый день,
Попробуйте формулу:
Код
=(SUMPRODUCT(O17:T33;(B17:B33=H2)*(O13:T13=I1)))
Страницы: 1 2 3 След.
Наверх