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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 35 След.
Извлечь из текста фрамент, размещенный в скобках
 
Код
=ОБЪЕДИНИТЬ("; ";1;ЕСЛИОШИБКА(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A1;"(";СИМВОЛ(1));")";СИМВОЛ(1));СИМВОЛ(1);"</i><i>")&"</i></j>";"//i[position() mod 2 = 0]");""))
Как вытащить из строки подстроку по маске расположенной в случайном порядке?
 
Можно выделить сначала xml: ФИЛЬТР.XML(ПСТР(B2;ПОИСК("<";B2);ДЛСТР(B2));"//*"), а далее его обработать с учетом что ФИО 4-ая запись с конца
Код
=ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(ФИЛЬТР.XML(ПСТР(B2;ПОИСК("<";B2);ДЛСТР(B2));"//*");"|";"</i><i>")&"</i></j>";"//i["&СЧЁТЗ(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(ФИЛЬТР.XML(ПСТР(B2;ПОИСК("<";B2);ДЛСТР(B2));"//*");"|";"</i><i>")&"</i></j>";"//i"))-4&"]")
Изменено: Тимофеев - 26.06.2022 13:37:34
Разрешить ввод в ячейку при условии
 
Код
Проверка данных-Другой-Формула и дальше примерно так,
если нужны еще условия дописывайте длстр, ПСТР(A1;7;8)="." и.т.д. и.т.п
=И(ЕЧИСЛО(--ПСТР(A1;1;6));ЕЧИСЛО(--ПСТР(A1;8;11));ЕЧИСЛО(--ПСТР(A1;13;19)))
Изменено: Тимофеев - 24.06.2022 08:54:31
Как массово удалить слова из списка в заданном столбце?
 
Код
Option Explicit
Function ClearWords(s As String, rWords As Range) As String
Static RX As Object
    If RX Is Nothing Then
        Set RX = CreateObject("VBScript.RegExp")
        RX.Global = True
        RX.IgnoreCase = True
    End If
RX.Pattern = "\b" & Replace(Join(Application.Transpose(rWords), "|"), ".", "\.") & "\b"
ClearWords = Application.Trim(RX.Replace(s, ""))
End Function
Счет чисел из текстовой строки по текстовому шаблону
 
Код
=СУММ(
ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ($D$5&"/"&$E$5&"/"&$F$5;"/";"</i><i>")&"</i></j>";"//i")*
(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ($D$6&"/"&$E$6&"/"&$F$6;"/";"</i><i>")&"</i></j>";"//i")=G4))
Разделить таблицу на файлы
 
New, раз ветка бесплатная то может покажете Всем?
Формула из 128-131 сделать 128, 129, 130, 131 (отдельно в каждой ячейке)
 
Ctrl+Shift+Enter
Формула из 128-131 сделать 128, 129, 130, 131 (отдельно в каждой ячейке)
 
Код
=ПОСЛЕД(1;
ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A1;"-";"</i><i>")&"</i></j>";"//i[2]")-
ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A1;"-";"</i><i>")&"</i></j>";"//i[1]")+1;
ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A1;"-";"</i><i>")&"</i></j>";"//i[1]");
1)
Отобразить в диалоговом окне только листы выбранной книги
 
все что есть, больше нет ничего
Дмитрий, тут еще вопрос по применении Вашей функции с Вашего сайта Как получить расшифровку значений в формулах в соседней ячейке (planetaexcel.ru)
Код
Option Explicit
Sub ReorganizeWithDialog()
    Dim wb As Workbook
    Set wb = ShowFileDialog()
    If Not wb Is Nothing Then
        Application.Dialogs(xlDialogWorkgroup).Show ActiveSheet.Name
        Reorganize wb
        wb.Close False
    End If
End Sub
Function ShowFileDialog() As Workbook
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Выбрать файлы" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Name 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewList 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Function 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To 1 '.SelectedItems.Count
            x = .SelectedItems(lf) 'считываем полный путь к файлу
            Set ShowFileDialog = Workbooks.Open(x) 'открытие книги
            'можно также без х
            'Workbooks.Open .SelectedItems(lf)
        Next
    End With
End Function
Sub Reorganize(wb As Workbook)
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = ActiveSheet
    Dim arr As Variant
    arr = GetArr(sh1)
    Set sh2 = GetSh2(sh1)
    Dim frr As Variant
    frr = GetNoEmptyRowArr(arr, sh1, sh2)
    If Not IsEmpty(frr) Then
        OutArr frr, sh2
        SaveWb sh2.Parent, wb
    End If
End Sub
Sub SaveWb(wb2 As Workbook, wb1 As Workbook)
    Dim newName As String
    newName = GetNewName(wb1.Name)
    newName = wb1.Path & "\" & newName
    On Error Resume Next
    Kill newName
    On Error GoTo 0
    wb2.SaveAs Filename:=newName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    'wb2.Close
End Sub
Function GetNewName(ByVal oldName As String) As String
    oldName = Replace(oldName, ".xlsb", ".xlsx")
    oldName = Replace(oldName, ".xlsm", ".xlsx")
    oldName = Replace(oldName, ")", "(")
    Dim arr As Variant
    arr = Split(oldName, "(")
    Dim newName As String
    If UBound(arr) > 0 Then
        If IsNumeric(arr(UBound(arr))) Then
            arr(UBound(arr)) = arr(UBound(arr)) + 1
            arr(UBound(arr)) = "(" & arr(UBound(arr)) & ")"
            newName = Join(arr, "")
        End If
    End If
    If newName = "" Then
        With CreateObject("Scripting.FileSystemObject")
            newName = .GetBaseName(oldName) & " (Объемы).xlsx"
        End With
    End If
    GetNewName = newName
End Function
Function GetSh2(sh1 As Worksheet) As Worksheet
    Dim sh2 As Worksheet
    sh1.Copy
    Set sh2 = ActiveSheet
    sh2.Cells.Clear
    With sh2.PageSetup
        .Orientation = xlPortrait
        .LeftMargin = Application.InchesToPoints(1.96850393700787)
        .RightMargin = Application.InchesToPoints(1.96850393700787)
        .TopMargin = Application.InchesToPoints(1.96850393700787)
        .BottomMargin = Application.InchesToPoints(3.93700787401575)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
    End With
    Set GetSh2 = sh2
End Function
Sub OutArr(arr As Variant, sh2 As Worksheet)
    'With Workbooks.Add(1)
    With sh2.Parent
        With .Sheets(1)
            With .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2))
                .Cells = arr
            End With
        End With
        .Saved = True
    End With
End Sub
Function GetNoEmptyRowArr(arr As Variant, sh1 As Worksheet, sh2 As Worksheet) As Variant
    Dim y As Long
    Dim n As Long
    For y = 28 To UBound(arr, 1)
        n = n + 1 + IsEmpty(arr(y, 1))
    Next
    If n > 0 Then
        Dim brr As Variant
        ReDim brr(1 To n, 1 To UBound(arr, 2))
        Dim x As Integer
        Dim yOZ As Long
        n = 0
        For y = 28 To UBound(arr, 1)
            If Not IsEmpty(arr(y, 1)) And Not IsEmpty(arr(y, 2)) Then
                n = n + 1
                For x = 1 To UBound(arr, 2)
                    brr(n, x) = arr(y, x)

                Next
                If yOZ = 0 Then
                    yOZ = n
                    'brr(yOZ, 11) = 0
                End If
                If IsNumeric(brr(yOZ, 11)) Then
                    If IsNumeric(arr(y, 11)) Then
                        brr(yOZ, 11) = brr(yOZ, 11) - arr(y, 11)
                    End If
                End If
                sh1.Rows(y).Copy sh2.Cells(n, 1)
            End If
            If arr(y, 3) = "Всего по позиции:" Then
                If IsNumeric(brr(yOZ, 11)) Then
                    If IsNumeric(arr(y, 10)) Then
                        brr(yOZ, 11) = brr(yOZ, 11) + arr(y, 10)
                    End If
                End If
                yOZ = 0
            End If
        Next
        GetNoEmptyRowArr = brr
    End If
End Function
  
Function GetArr(sh As Worksheet) As Variant
    With sh
        GetArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 3).End(xlUp).Cells(1, 11 - 2))
    End With
End Function
Изменено: Тимофеев - 21.06.2022 15:07:25
Удалить 6 подряд идущих цифр и запятую за ней. А также все, что после символа ";", VBA
 
в ворд найти и заменить посерьезнее чем в эксель, было бы неплохо чтоб добавили такую возможность
Как использовать подстановочные символы и регулярные выражения при поиске и замене в Word - zaWindows.ru
Изменено: Тимофеев - 21.06.2022 15:05:27
Отобразить в диалоговом окне только листы выбранной книги
 
да я наверное путаю, тогда наверное в этом Application.Dialogs(xlDialogWorkgroup).Show ActiveSheet.Name
Код
Sub ReorganizeWithDialog()
    Dim wb As Workbook
    Set wb = ShowFileDialog()
    If Not wb Is Nothing Then
        Application.Dialogs(xlDialogWorkgroup).Show ActiveSheet.Name
        Reorganize wb
        wb.Close False
    End If
End Sub
Отобразить в диалоговом окне только листы выбранной книги
 
Добрый вечер!
Есть функция открывающая диалоговое окно, При открытии показываются имена листов всех открытых книг и листы книги, которую нужно открыть, причем в диалоге уже стоит выбор на каком -то листе.
Как не показывать листы всех открытых книг, а только выбранной и как сделать так чтобы в диалоговом окне не был выделен какой-либо из листов?
Код
Function ShowFileDialog() As Workbook
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Выбрать файлы" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Name 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewList 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Function 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To 1 '.SelectedItems.Count
            x = .SelectedItems(lf) 'считываем полный путь к файлу
            Set ShowFileDialog = Workbooks.Open(x) 'открытие книги
            'можно также без х
            'Workbooks.Open .SelectedItems(lf)
        Next
    End With
End Function
Изменено: Тимофеев - 20.06.2022 20:57:17
Как указать несколько исходных массивов в функции ФИЛЬТР ?
 
Код
=ИНДЕКС(ФИЛЬТР(A3:D7;D3:D7=1);ПОСЛЕД(СЧЁТЕСЛИ(D3:D7;1));{1;3})
Нужно формула по поиску значений из диапазона по критерию
 
Код
=ИНДЕКС(B2:B5;ПОСЛЕД(СЧЁТЕСЛИ(C2:C5;B10)))
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
Не знаю какова вероятность, что автор тему глянет. Но подождём маленько
Как сосчитать сумму условно отформатированных ячеек
 
У вас там нет условного форматирования
Вот статья: Подсчитать сумму ячеек по цвету заливки (excel-vba.ru)
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
Создал файл пример. (Результат формулы неожиданный - ячейка В3 Листа 1 при ссылке на ячейку с формулами другого листа)
- Переименовал имя функции на Объем.
- Так же параметр "true" в функции для чего не понимаю
Очень странное поведение добавляю еще в формулу Е2 на втором листе плюс ещё какую-нибудь ссылку, перехожу на лист 1 - формула показывает, захожу в В3 на Лист1 нажимаю Enter - данные из ячеек второго листа пропадают...
Изменено: Тимофеев - 17.06.2022 17:56:38
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
МатросНаЗебре, в ячейку на которую ссылаюсь: =100*К!F10+К!E20-К!I20+I52
результат: =GetCellFormula(Source!I28)'=100*К!F10+К!E20-К!I20+I52,
а цель подставить значения вместо адресов с разных листов
GetCellFormula()=Ф.Текст()

Jack Famous, Вопрос возник
в ячейке: =A9+B9+C9/Лист2!B7+D9+(Лист2!A7+Лист2!C7)*Лист1!B9, D9 - пустая
Результат: '=10+20+30/30++(10+40)*20 - т.е. 0 не показывает
Изменено: Тимофеев - 17.06.2022 16:46:19
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
Jack Famous, спасибо !
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
Excel то поддерживает, но не поможет допустим формула в ячейке С2
=A1*A14+(5+C13)*C14 /B11+Лист2!B10
примет вид
=Ф.ТЕКСТ(C2)=A1*A14+(5+C13)*C14 /B11+Лист2!B10
Макрос от The_Prist(Щербаков Дмитрий) по ссылке из поста 4 делает что нужно, но ячейки нужно выделять, если бы это была UDF было бы шикарно
Изменено: Тимофеев - 17.06.2022 15:25:17
Свод данных столбца по совпадающему слову, Свод данных столбца по совпадающему слову
 
Код
=СУММ(C2:C30*ЕСЛИОШИБКА(ПОИСК("масло";B2:B30);0))
Изменено: Тимофеев - 17.06.2022 15:12:32
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
Может есть у кого в закромах готовая UDF для отображения в формулах вместо ссылок на ячейки их значения?
Поделитесь пожалуйста, при наличии
Свод данных столбца по совпадающему слову, Свод данных столбца по совпадающему слову
 
Код
=ФИЛЬТР(B:C;ЕСЛИОШИБКА(ПОИСК("коврик";B:B);0)=1)
Как удалить пустые переносы строк до и после текста?
 
Код
так уберет если и между есть пустые переносы
=ОБЪЕДИНИТЬ(СИМВОЛ(10);1;ЕСЛИОШИБКА(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(A1;СИМВОЛ(10);"</i><i>")&"</i></j>";"//i");""))
Изменено: Тимофеев - 17.06.2022 09:16:49
Как получить расшифровку значений в формулах в соседней ячейке, Как получить расшифровку значений в формулах в соседней ячейке
 
Есть статья об этом с примером:
Отобразить в формулах вместо ссылок на ячейки значения ячеек (excel-vba.ru)
Как бы ее сделать функцией? =ПодставитьЗначения(A1)
Может кто-то переделает под функцию? - было бы полезно!
Изменено: Тимофеев - 17.06.2022 09:17:33
Как распределить текст по столбцам?
 
Код
График:
=ПСТР(ПСТР([@Удалить];1;ПОИСК([@Телефон];[@Удалить];1)-1);ПОИСК([@Адрес];[@Удалить];1)+ДЛСТР([@Адрес])+1;1000)
Примечание:
=ПСТР([@Удалить];ПОИСК([@Телефон];[@Удалить];1)+13;1000)
Как распределить текст по столбцам?
 
Код
часть формул
Организация:
=ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ([@Удалить];СИМВОЛ(10);"</i><i>")&"</i></j>";"//i[1]")
Город:
=ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(ПОДСТАВИТЬ([@Удалить];",";СИМВОЛ(10));СИМВОЛ(10);"</i><i>")&"</i></j>";"//i[2]")
Адрес:
=ПСТР(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ([@Удалить];СИМВОЛ(10);"</i><i>")&"</i></j>";"//i[2]");ПОИСК(",";ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ([@Удалить];СИМВОЛ(10);"</i><i>")&"</i></j>";"//i[2]");1)+2;1000)
Телефон:
=ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ([@Удалить];СИМВОЛ(10);"</i><i>")&"</i></j>";"//i[number()=.]")

Изменено: Тимофеев - 16.06.2022 20:03:24
Разделения текста по столбцам (формула), Необходимо разделить текст по столбцам с помощью формулы
 
Код
Съест нули формула:
=ТРАНСП(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(B5;СИМВОЛ(10);"</i><i>")&"</i></j>";"//i"))
так не съест:
=ТЕКСТ(ТРАНСП(ФИЛЬТР.XML("<j><i>"&ПОДСТАВИТЬ(B5;СИМВОЛ(10);"</i><i>")&"</i></j>";"//i"));"00000000")
Изменено: Тимофеев - 14.06.2022 11:08:14
Умножить числа в ячейках и сложить их произведения
 
скобку уберите последнюю
Умножить числа в ячейках и сложить их произведения
 
Код
для начала попробуйте в C1 вставить формулу
=MID(B1;1;SEARCH("~*";B1;1)-1)*MID(B1;SEARCH("~*";B1;1)+1;1001)
протяните её вниз
потом попробуйте в D1
=SUM(MID(B1:B2;1;SEARCH("~*";B1:B2;1)-1)*MID(B1:B2;SEARCH("~*";B1:B2;1)+1;1001))
потом принцип поймете
Изменено: Тимофеев - 13.06.2022 12:48:53
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 35 След.
Наверх