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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 263 След.
Почему при малом количестве данных файл много весит и тормозит. Как это исправить?
 
Цитата
New написал:
там тысячи невидимых графических объектов
сегодня как раз коллеги прибежали говорят не можем работать с файлом, выделил объекты и чуть не ах..,нул :D (еженедельно 2 раза в неделю около 100 человек просто копировали объекты в течении полугода))
Не бойтесь совершенства. Вам его не достичь.
Создать на 2 листе книги таблицу, которая содержит сведения о стоимости лечения в заданном отделении.
 
Дима Ковелько, а зачем второй лист? у вс же на первом все видно что и сколько стоит) используйте первый лист)
Не бойтесь совершенства. Вам его не достичь.
Получить итоговую таблицу с позицией и параметром из первой таблицы с приписанными датами к каждому параметру из второй табл.
 
entf, макросом
Код
Sub mrshkei()
Dim arr,  i As Long,  lr As Long, k As Long, cell As Range, x As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A4:B" & lr)
k = 4
For i = LBound(arr) To UBound(arr)
    Set cell = Columns(4).Find(arr(i, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not cell Is Nothing Then
        x = Application.WorksheetFunction.CountIf(Columns(4), arr(i, 1))
        Range("D" & cell.Row & ":D" & cell.Row + x - 1).Copy Destination:=Cells(k, 8)
        Range("E" & cell.Row & ":E" & cell.Row + x - 1).Copy Destination:=Cells(k, 10)
        Range(Cells(k, 9), Cells(k + x - 1, 9)) = arr(i, 2)
        k = k + x
    End If
Next i
Application.ScreenUpdating = True
End Sub

Изменено: Mershik - 21.10.2021 14:50:10
Не бойтесь совершенства. Вам его не достичь.
Умножить на 20% значения ячеек
 
Богдан Петрюк, забавно, что не видите #2

и еще забавнее https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=133031&a... смотрите #5  
Изменено: Mershik - 20.10.2021 17:38:01
Не бойтесь совершенства. Вам его не достичь.
Умножить на 20% значения ячеек
 
Богдан Петрюк, и чем не подошел вариант предложенный мною (только с учетом новых вводных не 1,2 а 1,32)
Не бойтесь совершенства. Вам его не достичь.
Умножить на 20% значения ячеек
 
Богдан Петрюк,
в любую ячейку пишите 1,2  - затем копируете это значение - выделяем ячейки в которых нужно добавить 20% - вставка - специальная вставка - операция - умножить  
Не бойтесь совершенства. Вам его не достичь.
Перенос строк в ячейках, Разбить данные из ячейки, которые забиты с переносом строки через Alt+Enter, построчно
 
acid26sk,
Код
Sub mrshkei()
Dim arr, arr2, arr3, i As Long, n As Long, lr As Long, k As Long, x As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A3:F" & lr)
For i = LBound(arr) To UBound(arr)
    arr2 = Split(arr(i, 4), vbLf)
    x = x + UBound(arr2) + 1
Next i
Z = UBound(arr, 2) - LBound(arr) + 1
ReDim arr3(1 To x, 1 To Z): k = 1
For i = LBound(arr) To UBound(arr)
    arr2 = Split(arr(i, 4), vbLf)
    arr22 = Split(arr(i, 5), vbLf)
    arr222 = Split(arr(i, 6), vbLf)
    For n = LBound(arr2) To UBound(arr2)
        arr3(k, 1) = arr(i, 1)
        arr3(k, 2) = arr(i, 2)
        arr3(k, 3) = arr(i, 3)
        arr3(k, 4) = arr2(n)
        arr3(k, 5) = CDate(arr22(n))
        arr3(k, 6) = CDate(arr222(n))
        k = k + 1
    Next n
Next i
Range("H3").Resize(UBound(arr3), Z) = arr3
End Sub
Изменено: Mershik - 20.10.2021 16:49:37 (внес поправки)
Не бойтесь совершенства. Вам его не достичь.
Замедление работы при реализации именованной формулы функцией ДВССЫЛ
 
Цитата
Arthur26 написал:
как реализовать макросом
ну это вопрос для другой темы, ге вы уже укажите что нужно сделать, из чего получить и каким должен быть результат...но не забывайте одна темы один вопрос
Не бойтесь совершенства. Вам его не достичь.
Замедление работы при реализации именованной формулы функцией ДВССЫЛ
 
Цитата
Arthur26 написал:
скрытие формул от пользователей
используйте тогда макрос
Не бойтесь совершенства. Вам его не достичь.
Замедление работы при реализации именованной формулы функцией ДВССЫЛ
 
Arthur26, спасибо за информацию...
Не бойтесь совершенства. Вам его не достичь.
Как распечатать длинную строку на одном листе с переносом строк
 
Цитата
Ігор Гончаренко написал:
сначала покажите что у вас за данные
Цитата
Михаил написал:
Безымянный.png

:D  
Изменено: Mershik - 19.10.2021 21:12:40
Не бойтесь совершенства. Вам его не достичь.
Поиск пар и подстановка строк по заданному диапазону
 
Ivan Farafonov, слАжный какой-то путь  не понятный, поэтому кка понял...
Изменено: Mershik - 20.10.2021 12:27:56 (заменил файл)
Не бойтесь совершенства. Вам его не достичь.
Сложный COUNTIF с условием по дате и времени
 
marthy, действительно сложный (без файл-примера)
Не бойтесь совершенства. Вам его не достичь.
Какая причина долгих расчетов без предварительного сохранения или открытия параметров экселя, почему скорость расчетов зависит от просмотра параметров экселя
 
andylu, сразу насколько знаю функция СМЕЩ очень тормознутая, если много их то будет думаю проблемы
Не бойтесь совершенства. Вам его не достичь.
Формула для распознания слова из справочника
 
Ольга Боб,
Цитата
Ольга Боб написал:
а вот в красной заливке ,не пойму почему она не распознает , если брэнд Фрисо или как пример Альфаре Аллерджи в списке, она не помечает "1"  
ну потому что ранее писал что должно быть как то все одинаково написано, для чего вы ставте в конце ";"  (точку с запятой) там где всего одна номенклатура
так нужно не точное совпадение ... хотя зачем вы выделили Фрисо Пеп; Фрисо Пеп АС; - для единичного не понятно
Изменено: Mershik - 18.10.2021 22:29:38
Не бойтесь совершенства. Вам его не достичь.
Формула для распознания слова из справочника
 
Ольга Боб, да нет вам нужно нормальный пример сделать,
а то у Вас в шапке искомых значений
что то в списке, что то просто список
Фрисо в спискеНутрилон толькоНутрилон списокНеокейт толькоНеокейт список
т.е. как они наываются так и писать

формула если у Вас в шапке написано так же как и в 1 столбце через "в списке" или "только" и не для нескольки позиций, для нескольки макрос навреное или чет еще)
в с4 и протянуть:
Код
=ЕСЛИ(C$3="един";ЕСЛИ(ПОДСТАВИТЬ(C$2;" только";"")=$A4;1;"");ЕСЛИ(И(ЕЧИСЛО(ПОИСК(ПОДСТАВИТЬ(C$2;" в списке";"");$A4));ЕЧИСЛО(ПОИСК(";";$A4)));1;""))
Изменено: Mershik - 18.10.2021 11:57:47
Не бойтесь совершенства. Вам его не достичь.
Разделение данных ячейки на строки.
 
Алёна, еще вариант
Код
Sub mrshkei()
Dim arr, arr2, arr3, i As Long, j As Long, n As Long, k As Long, lr As Long, x As Long
x = 6
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A1:F" & lr)
ReDim arr3(1 To lr * 5, 1 To x): k = 2
For i = 1 To x
    arr3(k - 1, i) = arr(1, i)
Next i
For i = LBound(arr) + 1 To UBound(arr)
    arr2 = Split(arr(i, 4), ", ")
    For n = LBound(arr2) To UBound(arr2)
    If UBound(arr2) > 0 And arr2(n) = "NO" Then GoTo M
        arr3(k, 1) = arr(i, 1)
        arr3(k, 2) = arr(i, 2)
        arr3(k, 3) = arr(i, 3)
        arr3(k, 4) = arr2(n)
        arr3(k, 5) = arr(i, 5)
        arr3(k, 6) = arr(i, 6)
        k = k + 1
M:
    Next n
Next i
Range("H1").Resize(UBound(arr3), x) = arr3
End Sub
Не бойтесь совершенства. Вам его не достичь.
Нахождение связей между объектами
 
lomaxx, чет судя по результату нужно просто посчитать по столбцам да и выбрат 5-7 наибольших)
Изменено: Mershik - 13.10.2021 17:35:51
Не бойтесь совершенства. Вам его не достичь.
Как выдернуть записи по ключевому полю из одной ячейки
 
Цитата
Сергей Ки написал:
как этим воспользоваться?    
Код
https://e-xcel.ru/index.php/makrosy/124-kak-vstavit-gotovyj-makros-v-rabochuyu-knigu
Не бойтесь совершенства. Вам его не достичь.
Формула для распознания слова из справочника
 
Ольга Боб, А что языки разные так задумано? если да то ответ нет, или создавать список еще "переводов" или сделать все на одном языке
Изменено: Mershik - 13.10.2021 12:23:28
Не бойтесь совершенства. Вам его не достичь.
Связанные выпадающие списки не в отсортированном справочнике
 
Delux, например макросом...https://coderoad.ru/45871402/%D0%92%D1%8B%D0%BF%D0%B0%D0%B4%D0%B0%D1%8E%D1%89­%D0%B8%D0%B9-%D1%81%D0%...
Не бойтесь совершенства. Вам его не достичь.
Замена символа во всей книге макросом
 
Maxim,
Код
Sub mrshkei()
Dim sh As Worksheet
For Each sh In Worksheets
    sh.Cells.Replace What:="=", Replacement:="=", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next sh
End Sub

Не бойтесь совершенства. Вам его не достичь.
Сформировать выборку по сотруднику с распечаткой полного списка дней
 
Oleksandr Vorotniak, без форматирования,  в каждом листе в первую строку добавил название шапк ручками:
Код
Sub mrshkei()
Dim arr, i As Long, n As Long, lr As Long
Dim sh As Worksheet, sh2 As Worksheet
Set sh = Worksheets("Данные")
For Each sh2 In Worksheets
    If sh2.Name <> sh.Name Then sh2.Range(sh2.Cells(2, 1), sh2.Cells(65536, 4)).Clear

Next sh2
With sh
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A2:D" & lr)
    For i = LBound(arr) To UBound(arr)
    Set sh2 = Worksheets(arr(i, 4))
        lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        sh2.Cells(lr, 1).Resize(1, 4).Value = WorksheetFunction.Index(arr, i, 0)
    Next i
End With
End Sub
Изменено: Mershik - 08.10.2021 22:34:49
Не бойтесь совершенства. Вам его не достичь.
Автоматизация перемещения единицы товара на магазины с нулевым остатком и продажами более нуля
 
JayBhagavan,  :D  
Не бойтесь совершенства. Вам его не достичь.
Расчет времени опозданий по нескольким условиям
 
Цитата
Irina написал:
Есть понимание, что хочу,
так можете поделитесь условиями задачи? не много расскажете, что есть и что хотите получить на выходе...
Не бойтесь совершенства. Вам его не достичь.
Сравнить два столбца и выяснить, какие ячейки одного столбца содержат частичный текст ячеек другого столбца
 
Екатерина Мезенцева,без файла-примера наверное никак
Не бойтесь совершенства. Вам его не достичь.
Автозаполнение даты и очистка ячейки, Корректировка кода
 
Vadim181,
Код
Private Sub Worksheet_Change(ByVal Target As Range)
     
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("B2:D66")) Is Nothing Then   'если измененная ячейка попадает в диапазон B2:B66
        If cell = Empty Then                  'если в B2:B66 пусто, то
            Cells(Target.Row, 1) = Empty       'очищаем ячейку колонки А
        Else 'в ином случае (если диапазон B2:B66 не пустой), то
            With Range("A" & cell.Row) 'вводим в ячейку, в столбец A дату
               .Value = Date
          End With
       End If
    End If
  Next cell
End Sub

Не бойтесь совершенства. Вам его не достичь.
Проверка наличия листов по списку, Проверка наличия листов по списку (перед копированием данных с этих листов)
 
Сергей Цымбалистый, добрый день
Код
Sub mrshkei()
Dim arr, sh As Worksheet, i As Long
arr = Array("Подрядчик 1", "Подрядчик 2", "Подрядчик 3", "Подрядчик 4", "Подрядчик 5", "Подрядчик 6", "Подрядчик 7")
For i = LBound(arr) To UBound(arr)
k = 0
    For Each sh In Worksheets
        If sh.Name = arr(i) Then GoTo M
    Next sh
        If tt = "" Then
            tt = arr(i)
        Else
            tt = tt & vbLf & arr(i)
        End If
M:
Next i
If tt = "" Then
    ' ваша часть кода
Else
    MsgBox ("НЕТ ДАННЫХ ПО СЛЕДУЮЩИМ ПОДРЯДЧИКАМ:" & vbLf & vbLf & tt)
End If
End Sub
Изменено: Mershik - 07.10.2021 09:17:49
Не бойтесь совершенства. Вам его не достичь.
Выделение жирным шрифтом только цифры в столбце
 
maxvel333, допустим Ваши значение начинаются в А1 и вниз по столбцу А:
Код
Sub mrshkei()
Dim arr, i As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0")
For i = 1 To lr
    x = Len(Cells(i, 1))
    For n = 1 To x
        For j = LBound(arr) To UBound(arr)
            If arr(j) = Mid(Cells(i, 1), n, 1) Then
                Cells(i, 1).Characters(Start:=n, Length:=1).Font.Bold = True
            End If
        Next j
M:
    Next n
Next i
End Sub
Изменено: Mershik - 06.10.2021 21:21:42
Не бойтесь совершенства. Вам его не достичь.
Из плоской таблицы в кросс(перекрестную)-таблицу, Форматирование таблицы для импорта через CSV
 
Никита Колюбанов, а что Вам не подошло в макросе в #3?
New, ага, спасибо исправил)
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 263 След.
Наверх