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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 274 След.
Распределение общего адреса из одной ячейки в несколько соседних согласно заданного условия
 
Михаил Михаил, возможно Вам поможет:
1. https://www.planetaexcel.ru/techniques/7/5636/
2. https://www.planetaexcel.ru/techniques/7/11627/
Не бойтесь совершенства. Вам его не достичь.
Распределение общего адреса из одной ячейки в несколько соседних согласно заданного условия
 
Михаил Михаил,  чем не подходит текст по столбцам? а если прям нужно определить город в тексте в котором много чего еще есть и улицу, нужны словари со всеми названиями городов и улиц)_
Изменено: Mershik - 18.01.2022 17:04:28
Не бойтесь совершенства. Вам его не достичь.
[ Закрыто] Сборка данных
 
Цитата
dew1582 написал:
должна выполняться сборка данных с вкладок (АВУ1, АВУ-2, АТУ, ЛНК, ЭХЗ, ПТО) на сводный лист "СВОД ПО УЧАСТКАМ",
ловите:
Код
Sub mrshkei()
Dim arrSH, arr, j As Long, i As Long, lr As Long, sh As Worksheet, k As Long
Set sh = Worksheets("СВОД ПО УЧАСТКАМ")
sh.Range("A2:C" & sh.Cells(Rows.Count, 3).End(xlUp).Row + 2).ClearContents
arrSH = Array("АВУ-1", "АВУ-2", "АТУ", "ЛНК", "ЭХЗ", "ПТО")
k = 2
For i = LBound(arrSH) To UBound(arrSH)
    With Worksheets(arrSH(i))
        lr = .Cells(Rows.Count, 2).End(xlUp).Row
        arr = .Range(.Cells(5, 2), .Cells(lr, 3))
        sh.Cells(k, 2).Resize(UBound(arr), 2) = arr
        k = k + UBound(arr)
    End With
Next i
sh.Cells(2, 1) = 1: sh.Cells(3, 1) = 2
sh.Range("A2:A3").AutoFill Destination:=Range("A2:A" & k - 1)
End Sub
Изменено: Mershik - 18.01.2022 16:05:03
Не бойтесь совершенства. Вам его не достичь.
Сбор значений из нескольких ячеек в одно предложение
 
Код
=E6&" - "&G6&", "&D6&", "&C6
Не бойтесь совершенства. Вам его не достичь.
[ Закрыто] Сборка данных
 
dew1582,  добрый день, нет никакой конкретики, что Вам нужно, в каком виде? вы бы описали что нужно взять вот это вставить сюда и получить в таком виде (показать в файле при этом).
Изменено: Mershik - 18.01.2022 11:42:18
Не бойтесь совершенства. Вам его не достичь.
Фильтрация по нескольким столбцам
 
Цитата
Кирилл Безденежных написал:
мне же необходимо что бы в строчки где нет определенный операции не отображались вовсе
вам че религия не позволяет нажать на фильтр и выбрать 1) и в итоге все остальное исчезнет
Изменено: Mershik - 13.01.2022 16:54:20
Не бойтесь совершенства. Вам его не достичь.
Фильтрация по нескольким столбцам
 
Цитата
Кирилл Безденежных написал:
смотрел Ваш файл
не состыковывается с
Цитата
Кирилл Безденежных написал:
мне необходимо что бы при фильтрации по названию операции в листе остались только те строки в которые эта операция есть
там это же самое
Не бойтесь совершенства. Вам его не достичь.
Фильтрация по нескольким столбцам
 
Кирилл Безденежных,  вы файл мой смотрели*
и да вариант от МатросНаЗебре, просто фильтр ставите по нужномуслову и все
Изменено: Mershik - 13.01.2022 16:33:30
Не бойтесь совершенства. Вам его не достичь.
Фильтрация по нескольким столбцам
 
Кирилл Безденежных,  ну руками вы то можете его сделать? представте что вы нажали чудо кнопку и появился тот результат который вам нужен, вот сделайте рядом то что нужно руками (оставте те строки).
пока я понял что если хоть раз в стркое есть нужный фильтр вам то они должны остатся ..смотрите файл
Изменено: Mershik - 13.01.2022 16:22:20
Не бойтесь совершенства. Вам его не достичь.
Фильтрация по нескольким столбцам
 
Кирилл Безденежных,  хотите то - покажите в файле  желаемый результат тот который ожидаете
Изменено: Mershik - 13.01.2022 16:00:50
Не бойтесь совершенства. Вам его не достичь.
Остановка работы макроса отправки почты
 
Максим Колесников,
Код
 Application.Wait Time:=Now + TimeValue("0:00:05")
Не бойтесь совершенства. Вам его не достичь.
Поиск значения по месяцу и году
 
Цитата
Валерий Кишин написал:
Выглядит "костыльно",
ИНТРЕСНОЕ ПРЕДПОЛОЖЕНИЕ ... обоснуйте в чем костыль?
Изменено: Mershik - 12.01.2022 15:01:59
Не бойтесь совершенства. Вам его не достичь.
Сбор столбцов со значениями из разных файлов в один (с возможностью обновления!)
 
Сергей020487,
Цитата
Сергей020487 написал:
В примере все поймёте.
НЕ ПОНЯЛ) ЭХ..да тут целое ТЗ..
Изменено: Mershik - 12.01.2022 14:23:25
Не бойтесь совершенства. Вам его не достичь.
Поиск значения по месяцу и году
 
Валерий Кишин,
Код
=ИНДЕКС($D$2:$D$6;ПОИСКПОЗ(КОНМЕСЯЦА(A2;-1)+1;$C$2:$C$6;0);1)
Не бойтесь совершенства. Вам его не достичь.
Создание строк в зависимости от количества указанного в строке
 
Цитата
Пожалуйста, давайте обойдемся без пассивно-агрессивной манеры общения.
, вы наверное ошиблись - это модератор он скорее всего безэмоциаонально Вам ответил так как следит за порядком на форуме
ТЕМА: Создание строк в зависимости от количества указанного в строке
Код
Sub mrshkei()
Dim i As Long, j As Long, lr As Long, cell As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:G" & lr): col = UBound(arr, 2) - LBound(arr) + 1
x = Application.WorksheetFunction.SumIf(Range("A2:G" & lr).Offset(1, 1), ">0", Range("A2:G" & lr).Offset(1, 1)) + 1
ReDim arr2(1 To x, 1 To col): k = 2
For i = 1 To col: arr2(k - 1, i) = arr(1, i): Next i
For i = LBound(arr) + 1 To UBound(arr)
    For j = 2 To col
        If arr(i, j) > 0 Then
            For jj = 1 To arr(i, j)
                arr2(k, 1) = arr(i, 1)
                    For n = 2 To col
                        If n <> j Then
                            arr2(k, n) = 0
                        Else
                            arr2(k, n) = 1
                        End If
                    Next n
                k = k + 1
            Next jj
        End If
    Next j
Next i
Range("S2").Resize(UBound(arr2), col) = arr2
End Sub
Изменено: Mershik - 11.01.2022 22:38:47
Не бойтесь совершенства. Вам его не достичь.
Автоматическая многоуровневая сортировка
 
Юрий Родионов,  это очень сложно  не нужно) лучше запускать макрос с кнопки...
Код
Sub mrshkei()
Dim i As Long, n As Long, k As Long, lr As Long, col As New Collection, sh As Worksheet, sh2 As Worksheet, j As Long, j2 As Long
Set sh = ActiveSheet
Application.ScreenUpdating = False
k = 7 'начало строк с данными
lr = Cells(Rows.Count, 2).End(xlUp).Row 'посл. строка
For i = k To lr
    On Error Resume Next
    col.Add sh.Cells(i, 2).Interior.ColorIndex, CStr(sh.Cells(i, 2).Interior.ColorIndex)
Next i
Sheets.Add
With ActiveSheet
Set sh2 = ActiveSheet
    .Name = Replace(Date, "-", "-")
j = 1

For n = 1 To col.Count
j2 = j
    For i = k To lr
        If sh.Cells(i, 2).Interior.ColorIndex = CDbl(col(n)) Then
        sh.Range(sh.Cells(i, 2), sh.Cells(i, 14)).Copy Destination:=.Cells(j, 1)
        j = j + 1
        End If
    Next i
    
        '.Range(.Cells(j2, 1), .Cells(j - 1, 13)).Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range( _
        "A" & j2 & ":A" & j - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A" & j2 & ":M" & j - 1)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next n
sh.Activate
.Range("A1:M" & j - 1).Copy
sh.Cells(k, 2).Select
ActiveSheet.Paste
End With
Application.DisplayAlerts = False
sh2.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Цитата
Юрий Родионов написал: С макросами дело не имел никогда.
разбирайтесь)
Изменено: Mershik - 10.01.2022 22:11:39
Не бойтесь совершенства. Вам его не достичь.
Автоматическая многоуровневая сортировка
 
Цитата
Юрий Родионов написал:
Допустим я внёс изменения в ячейках [I56] и [J56] и окрасил их в зелёный. Так мне надо чтобы он встал на 26 строку
почему именно в 26?? а не в 50?
поймите не понятна логика, удостойте нас своими разъяснениями почему именно так а видимо разъяснение "делает другая программа..." тогда в ней  меняйте на зеленый  цвет  ифбудет сортировать как вам нужно, а макросу нужно написать что и когда делать.
Изменено: Mershik - 10.01.2022 21:19:44
Не бойтесь совершенства. Вам его не достичь.
Автоматическая многоуровневая сортировка
 
Юрий Родионов,  а есть логика установки цвета? или вы просто произвольно ее выбираете?
а еще не понятно как отсортировано по адресу так как если сортировать по адресу будет совсем подругому
Изменено: Mershik - 10.01.2022 21:14:43
Не бойтесь совершенства. Вам его не достичь.
Макрос копирования данных из одной таблицы в последнюю свободную строку другой
 
Дмитрий, пожалуйста, еще и свой же макрос дорабатываю (думаю что-то знакоме))
Изменено: Mershik - 10.01.2022 17:22:43
Не бойтесь совершенства. Вам его не достичь.
Макрос копирования данных из одной таблицы в последнюю свободную строку другой
 
Дмитрий, просто замените  
Код
lr = sh.Application.WorksheetFunction.Count(sh.Range("C3:C100000"))
на
Код
lr = sh.Application.WorksheetFunction.CountA(sh.Range("C3:C100000"))
Не бойтесь совершенства. Вам его не достичь.
Макрос копирования данных из одной таблицы в последнюю свободную строку другой
 
Дмитрий, не понятно что значит не по порядку у меня по порядку - каждая  по очереди от первой к последней с первого листа и в последнюю пустую второго листа друг за другом, а что у Вас не так не знаю
Изменено: Mershik - 10.01.2022 16:53:08
Не бойтесь совершенства. Вам его не достичь.
Создание новой строки, объединение ячеек и изменение формата ячеек при выполнении условия
 
Лена Полева , ЗАБЫЛ  о формате, но кстати объединение зло,
Код
Sub meshkei()
Dim i As Long, n As Long, lr As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step -1
    If Cells(i, 7) = "Да" And Cells(i, 7) <> "" Then
        Rows(i + 1 & ":" & i + 1).Insert
        For n = 1 To 12
            If n <> 8 Then
                Range(Cells(i, n), Cells(i + 1, n)).Merge
            Else
            Cells(i, n).NumberFormat = "dd/mm/yyyy Дата протокола"
             Cells(i + 1, n).NumberFormat = "dd/mm/yyyy Дата подписания"
            End If
        Next n
    End If
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



Изменено: Mershik - 10.01.2022 16:48:52
Не бойтесь совершенства. Вам его не достичь.
Макрос копирования данных из одной таблицы в последнюю свободную строку другой
 
Дмитрий,
Код
Sub ÄîáàâèòüÏðîä()
Dim sh As Worksheet, sh2 As Worksheet, lr As Long, i As Long, k As Long, x As Long
Set sh = Worksheets("Ðååñòð ïðîäàæ"): Set sh2 = Worksheets("Ïðîäàæè")
Application.ScreenUpdating = False
With sh2
k = Application.WorksheetFunction.CountIf(.Columns(16), "a")
If k = 0 Then
MsgBox "Ôîðìà ââîäà íå çàïîëíåíà!", vbCritical, "Îøèáêà çàïèñè"
Exit Sub
End If
Worksheets("Ðååñòð ïðîäàæ").Unprotect Password:=""
    lr2 = .Cells(Rows.Count, 15).End(xlUp).Row
    For i = 7 To lr2
    lr = sh.Application.WorksheetFunction.Count(sh.Range("C3:C100000"))
    If lr = 0 Then lr = 3 Else lr = lr + 3
        If .Cells(i, 16) = "a" Then
            sh.Rows(lr & ":" & lr).Insert
            .Range("C" & i & ":O" & i).Copy
            sh.Cells(lr, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next i
End With
sh.Activate
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.ScreenUpdating = True
End Sub
Не бойтесь совершенства. Вам его не достичь.
Power query - преобразование многоуровневой шапки
 
Цитата

Сообщений:  36
а файл-пример не научились добавляТЬ)
Изменено: Mershik - 10.01.2022 12:21:56
Не бойтесь совершенства. Вам его не достичь.
Экспортировать google contacts в power query, навести порядок и импортировать обратно в телефон
 
александр Ишора, без файла примера вряд ли конкретно кто-то что подскажет, но думаю выгрузив контакты их можно обработать макросом  (есл там есть конечно логика, но я думаю она есть) и потом уже загрузите назад
Не бойтесь совершенства. Вам его не достичь.
Найти сколько раз встречается текст в столбце по условию
 
Код
Sub mrshkei()
    Dim arr, arr2, arr3, arr4, i As Long, j As Long, n As Long, lr As Long
    Dim col As New Collection
    
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A2:B" & lr)
    
    For i = LBound(arr) To UBound(arr)
    arr2 = Split(arr(i, 2), ",")
        For j = LBound(arr2) To UBound(arr2)
            On Error Resume Next
            col.Add Trim(arr2(j)), CStr(Trim(arr2(j)))
        Next j
    Next i
    ReDim arr3(1 To col.Count, 1 To 3)
    For i = 1 To col.Count
    arr3(i, 1) = col(i)
        For j = LBound(arr) To UBound(arr)
            If InStr(arr(j, 2), col(i)) > 0 Then
                x = Round(1 / (UBound(Split(arr(j, 2), ",")) + 1), 2)
                If arr3(i, 2) = Empty Then arr3(i, 2) = x Else arr3(i, 2) = arr3(i, 2) & "+" & x
                arr3(i, 3) = arr3(i, 3) + x
            End If
        Next j
    Next i
    Range("D11").Resize(UBound(arr3), 3) = arr3
End Sub
Не бойтесь совершенства. Вам его не достичь.
изменение не открывая файл, замена содержимого всех ячеек не открывая файл
 
vasily86,  если в нем это написать - то конечно
Не бойтесь совершенства. Вам его не достичь.
изменение не открывая файл, замена содержимого всех ячеек не открывая файл
 
vasily86,  никак, макросом можно открыть, сделать нужное и закрыть
Не бойтесь совершенства. Вам его не достичь.
Извлечь с другого листа данные по трем условиям, ускорить вычисления
 
Валерий Кишин, никто ничего не скажет если не увидим ваши данные, то что вы хотите получить на выходе и не опишите условия
Не бойтесь совершенства. Вам его не достичь.
Формат ячейки для чисел, близких к нулю
 
Цитата
lipun написал:
Правда, пока не совсем понимаю, как он будет работать
а вот как опишите так и будет) и где )
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 274 След.
Наверх