Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Msi2102
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 137 След.
Ранг с условием, Проранжировать внутри клиентов
 
#
16.06.2025 17:17:27
Добрый день!
Установите фильтр и сортируйте вначале по Штукам, потом по Клиенту, или воспользуйтесь Настраиваемой сортировкой, только тут наоборот вначале по клиенту, потом по штукам
Изменено: Msi2102 - 16.06.2025 17:22:14
 
Перейти    
Поиск стоимости по 4 выпадающим спискам с фильтрации, Вообще возможно такое?
 
#
16.06.2025 17:07:40
Можете почитать ТУТ или ТУТ
Изменено: Msi2102 - 16.06.2025 17:08:17
 
Перейти    
Вопрос по эксель с сохранением полученных значений.
 
#
16.06.2025 09:23:57
А ещё может быть АГРЕГАТ(), ПРОМЕЖУТОЧНЫЕ.ИТОГИ(), СУММПРОИЗВ(), СУММ()
Выбирайте  :D
 
Перейти    
Построение связанных таблиц
 
#
15.06.2025 08:59:41
Почитайте ТУТ
 
Перейти    
Удаление строки в другого листа, ранее добавленной по макросу
 
#
11.06.2025 12:20:55
Исправил, не обратил внимание на слово статус, думал нужно в желтых ячейка менять
Код
Private Sub Worksheet_Change(ByVal Target As Range)
'    Set trgt_rng = Range([C4], [C4].End(xlDown))
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        If Target.Count = 1 Then
            If Target.Value = "+" Then
                Set out_rng = Worksheets("Коммерч").[A1].Offset(Cells.Rows.Count - 2).End(xlUp).Offset(1)
                Target.EntireRow.Copy out_rng
                Application.CutCopyMode = False
            End If
            If Target.Value = "-" Then
                arr_1 = Worksheets("Коммерч").Range("A1:G" & Worksheets("Коммерч").Cells(Rows.Count, 2).End(xlUp).Row)
                For n = UBound(arr_1) To 1 Step -1
                    If arr_1(n, 2) = Target.Offset(0, -1).Value Then
                        Worksheets("Коммерч").Rows(n).Delete Shift:=xlUp
                        Exit For ' Если нужно удалить все строки с таким оборудованием то закомментировать эту строку
                    End If
                Next
            End If
        End If
    End If
End Sub
 
Перейти    
Удаление строки в другого листа, ранее добавленной по макросу
 
#
11.06.2025 11:42:51
Немного ошибся
Попробуйте так
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set trgt_rng = Range([C4], [C4].End(xlDown))
    If Target.Count = 1 Then
        If Target.Value = "+" Then
            Set out_rng = Worksheets("Коммерч").[A1].Offset(Cells.Rows.Count - 2).End(xlUp).Offset(1)
            Target.EntireRow.Copy out_rng
            Application.CutCopyMode = False
        End If
        If Target.Value = "-" Then
            arr_1 = Worksheets("Коммерч").Range("A1:G" & Worksheets("Коммерч").Cells(Rows.Count, 2).End(xlUp).Row)
            For n = UBound(arr_1) To 1 Step -1
                If arr_1(n, 2) = Target.Offset(0, -3).Value Then
                    Worksheets("Коммерч").Rows(n).Delete Shift:=xlUp
                    Exit For ' Если нужно удалить все строки с таким оборудованием то закомментировать эту строку
                End If
            Next
        End If
    End If
End Sub

У меня отрабатывает без ошибок
Изменено: Msi2102 - 11.06.2025 11:43:27
 
Перейти    
Удаление строки в другого листа, ранее добавленной по макросу
 
#
11.06.2025 10:51:27
Попробуйте так:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set trgt_rng = Range([C4], [C4].End(xlDown))
    If Target.Count = 1 Then
        If Target.Value = "+" Then
            Set out_rng = Worksheets("Коммерч").[A1].Offset(Cells.Rows.Count - 2).End(xlUp).Offset(1)
            Target.EntireRow.Copy out_rng
            Application.CutCopyMode = False
        End If
        If Target.Value = "-" Then
            arr_1 = Worksheets("Коммерч").Range("A1:G" & Worksheets("Коммерч").Cells(Rows.Count, 2).End(xlUp).Row)
            For n = UBound(arr_1) To 1 Step -1
                If arr_1(n, 2) = Target.Offset(0, -3) Then Worksheets("Коммерч").Rows(n).Delete Shift:=xlUp
                Exit For ' Если нужно удалить все строки с таким оборудованием то закомментировать эту строку
            Next
        End If
    End If
End Sub
 
Перейти    
Изменение формулы по событию, В зависимости от значения в ячейке на которую ссылается формула, она должна меняться и дополнительно сохранять сумму неизменной.
 
#
11.06.2025 09:17:17
Цитата
Виктор Васильев написал:
Есть ли возможность сохранять сумму по событию или с привязкой к дате
Создайте список дат со скидками, например
01.05.2025 - 10%
02.05.2025 - 15%
Цитата
Виктор Васильев написал:
может сделать зависимость количества проданного товара к скидке
В правильном направлении мыслите
 
Перейти    
Подсчет количества различающихся символов, Формулой или иным способом
 
#
11.06.2025 08:18:35
Цитата
gling написал:
Или я не так понял?
тут никто не понимает как надо, даже сам ТС не знает чего хочет🤣
 
Перейти    
ДР (ex HB)
 
#
10.06.2025 18:46:21
Цитата
Тимофеев написал:
картинка подарочек
А мне 1С-ники такую дарили
Изменено: Msi2102 - 10.06.2025 18:51:45
 
Перейти    
Подсчет количества различающихся символов, Формулой или иным способом
 
#
10.06.2025 17:09:00
Цитата
ALARMus написал:
может тогда разобрав каждый символ по строкам, найти в следующей колонке ASCII кодировку символа и уже можно применять сводную.
Можно так
или PQ, примерно так (кнопочный вариант)
Код
let
    Источник = Excel.CurrentWorkbook(){[Name="Таблица5"]}[Content],
    #"Разделить столбец по положению" = Table.ExpandListColumn(Table.TransformColumns(Источник, {{"Столбец1", Splitter.SplitTextByRepeatedLengths(1), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Столбец1"),
    #"Сгруппированные строки" = Table.Group(#"Разделить столбец по положению", {"Столбец1"}, {{"Количество", each Table.RowCount(_), Int64.Type}})
in
    #"Сгруппированные строки"
Изменено: Msi2102 - 10.06.2025 17:32:35
 
Перейти    
Подсчет количества различающихся символов, Формулой или иным способом
 
#
10.06.2025 15:26:15
Цитата
ПавелW написал:
счётесли() там не пойдёт поскольку есть ' '
я знаю, ещё там есть "?"  :D
Цитата
ПавелW написал:
и сводной по барабану регистр, если это имеет значение )
Я действовал строго по инструкции из сообщения №12  :D
 
Перейти    
Подсчет количества различающихся символов, Формулой или иным способом
 
#
10.06.2025 14:10:09
Цитата
ALARMus написал:
Фантазируя: транспанировать, каждый символ в отдельной ячейке, сводная таблица и количество символов по ней это количество строк в сводной таблице.
так?
 
Перейти    
ДР (ex HB)
 
#
10.06.2025 10:45:24
gling, с днюхой, всего самого наилучшего, здоровья, успехов и всего, всего, всего  :D
 
Перейти    
Собрать несколько столбцов в один
 
#
09.06.2025 17:43:06
Вообще не понятно, для чего это Вам нужно, но попробуйте так, может угадал
Код
Sub Collect()
    Dim i As Long, j As Long, a(), b()
    Application.ScreenUpdating = False
    a = Sheets("Лист1").UsedRange.Value ': Cells.Clear
    For i = 1 To UBound(a, 2) ' с какого столбика копировать "i = 4"
        j = Cells(Rows.Count, 1).End(xlUp).Row + 1
        b = Application.Index(a, 0, i)
        Cells(j, 1).Resize(UBound(b)).Value = b
    Next
    Columns(1).SpecialCells(4).Delete xlUp
End Sub
 
Перейти    
Копирование строки ниже, если в ячейке есть определённый текст
 
#
09.06.2025 17:02:32
Вот с названием листа, только при каждом запуске макроса лист Дубли очищается
ps ещё изменил макрос, наверно так будет правильнее (Макрос 2)
Код
Sub Макрос2()
    Dim arr, arr_1, arr_rez, arr_osh, n As Long, m As Long, k As Long, lr As Long, lc As Long, nm As String
    Set sd = CreateObject("Scripting.Dictionary")
    Set sd_osh = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, 2).End(xlUp).Row
    lc = Cells(8, Columns.Count).End(xlToLeft).Column
    nm = ActiveSheet.Name
    arr = Range(Cells(9, 1), Cells(lr, lc))
    arr = Range("A9:AQ" & lr)
    k = 0
    j = 0
    For n = 1 To UBound(arr)
        If arr(n, 1) <> "" Then
            arr_1 = Split(arr(n, 1), ",")
            For m = LBound(arr_1) To UBound(arr_1)
                If Not sd.Exists(arr_1(m) & "|" & arr(n, 2) & "|" & arr(n, 3)) Then
                    sd.Add arr_1(m) & "|" & arr(n, 2) & "|" & arr(n, 3), n
                    k = k + 1
                Else
                    If Not sd_osh.Exists("Строка " & n + 8) Then
                        sd_osh.Add "Строка " & n + 8, arr_1(m)
                        j = j + 1
                    Else
                        sd_osh("Строка " & n + 8) = sd_osh("Строка " & n + 8) & "; " & arr_1(m)
                    End If
                End If
            Next
        End If
    Next
    
    ReDim arr_rez(1 To k, 1 To lc)
    k = 1
    For Each y In sd
        arr_rez(k, 1) = Split(y, "|")(0)
        For n = 2 To lc
            arr_rez(k, n) = arr(sd(y), n)
        Next
        k = k + 1
    Next
    ActiveSheet.Copy Before:=Sheets(1)
    With Sheets(1)
        .Range(Cells(9, 1), Cells(9, lc)).ClearContents
        .Range(Cells(10, 1), Cells(lr, lc)).Clear
        .Range(Cells(9, 1), Cells(9, lc)).Copy
        .Range("A9").Resize(UBound(arr_rez), UBound(arr_rez, 2)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .Range("A9").Resize(UBound(arr_rez), UBound(arr_rez, 2)) = arr_rez
    End With
    
    Sheets("Дубли").Cells.Clear
    If j > 0 Then
        ReDim arr_osh(1 To j, 1 To 3)
        k = 1
        For Each y In sd_osh
            arr_osh(k, 1) = nm
            arr_osh(k, 2) = y
            arr_osh(k, 3) = sd_osh(y)
            k = k + 1
        Next
        Sheets("Дубли").Range("A1").Resize(UBound(arr_osh), UBound(arr_osh, 2)) = arr_osh
    End If
End Sub
 
Перейти    
Копирование строки ниже, если в ячейке есть определённый текст
 
#
09.06.2025 15:48:34
Немного изменил макрос, теперь если будет появляться дубль (наименование, производитель и код), то номера строк по Excel и повторяющиеся коды, будут отображаться на листе "Дубли"
Код
Sub Макрос1()
    Dim arr, arr_1, arr_rez, arr_osh, n As Long, m As Long, k As Long, lr As Long, lc As Long
    Set sd = CreateObject("Scripting.Dictionary")
    Set sd_osh = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, 2).End(xlUp).Row
    lc = Cells(8, Columns.Count).End(xlToLeft).Column
    arr = Range(Cells(9, 1), Cells(lr, lc))
    arr = Range("A9:AQ" & lr)
    k = 0
    j = 0
    For n = 1 To UBound(arr)
        If arr(n, 1) <> "" Then
            If Not sd.Exists(arr(n, 2) & "|" & arr(n, 3)) Then Set sd(arr(n, 2) & "|" & arr(n, 3)) = CreateObject("Scripting.Dictionary")
            arr_1 = Split(arr(n, 1), ",")
            For m = LBound(arr_1) To UBound(arr_1)
                If Not sd(arr(n, 2) & "|" & arr(n, 3)).Exists(arr_1(m)) Then
                    sd(arr(n, 2) & "|" & arr(n, 3)).Add arr_1(m), n
                    k = k + 1
                Else
                    If Not sd_osh.Exists("Строка " & n + 8) Then
                        sd_osh.Add "Строка " & n + 8, arr_1(m)
                        j = j + 1
                    Else
                        sd_osh("Строка " & n + 8) = sd_osh("Строка " & n + 8) & "; " & arr_1(m)
                    End If
                End If
            Next
        End If
    Next
    ReDim arr_rez(1 To k, 1 To lc)
    k = 1
    For Each y In sd
        For Each y1 In sd(y)
            arr_rez(k, 1) = y1
            For n = 2 To lc
                arr_rez(k, n) = arr(sd(y)(y1), n)
            Next
            k = k + 1
        Next
    Next
    ReDim arr_osh(1 To j, 1 To 2)
    k = 1
    For Each y In sd_osh
        arr_osh(k, 1) = y
        arr_osh(k, 2) = sd_osh(y)
        k = k + 1
    Next
    ActiveSheet.Copy Before:=Sheets(1)
    With Sheets(1)
        .Range(Cells(9, 1), Cells(9, lc)).ClearContents
        .Range(Cells(10, 1), Cells(lr, lc)).Clear
        .Range(Cells(9, 1), Cells(9, lc)).Copy
        .Range("A9").Resize(UBound(arr_rez), UBound(arr_rez, 2)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .Range("A9").Resize(UBound(arr_rez), UBound(arr_rez, 2)) = arr_rez
    End With
    With Sheets("Дубли")
        .Cells.Clear
        .Range("A1").Resize(UBound(arr_osh), UBound(arr_osh, 2)) = arr_osh
    End With
End Sub
Изменено: Msi2102 - 09.06.2025 15:50:12
 
Перейти    
Копирование строки ниже, если в ячейке есть определённый текст
 
#
09.06.2025 15:05:47
S.K., Единственное нужно следить, чтобы не было дулей кода, например есть Наименование 1, Производитель 1 и код 333333, а ниже строка такая же строка с тем же наименованием, производителем и кодом. Просто не знал, что с этим делать, то-ли их складывать, то-ли добавлять индекс типа 333333_1, пока просто выдаст ошибку
Изменено: Msi2102 - 09.06.2025 15:07:26
 
Перейти    
Копирование строки ниже, если в ячейке есть определённый текст
 
#
09.06.2025 14:42:45
Можно таким макросом, цикл по всем листам сами добавите
Код
Sub Макрос1()
    Dim arr, arr_1, arr_rez, n As Long, m As Long, k As Long, lr As Long, lc As Long
    Set sd = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, 2).End(xlUp).Row
    lc = Cells(8, Columns.Count).End(xlToLeft).Column
    arr = Range(Cells(9, 1), Cells(lr, lc))
    arr = Range("A9:AQ" & lr)
    k = 0
    For n = 1 To UBound(arr)
        If arr(n, 1) <> "" Then
            If Not sd.Exists(arr(n, 2) & "|" & arr(n, 3)) Then Set sd(arr(n, 2) & "|" & arr(n, 3)) = CreateObject("Scripting.Dictionary")
                arr_1 = Split(arr(n, 1), ",")
                For m = LBound(arr_1) To UBound(arr_1)
                    sd(arr(n, 2) & "|" & arr(n, 3)).Add arr_1(m), n
                    k = k + 1
                Next
        End If
    Next
    ReDim arr_rez(1 To k, 1 To lc)
    k = 1
    For Each y In sd
        For Each y1 In sd(y)
            arr_rez(k, 1) = y1
            For n = 2 To lc
                arr_rez(k, n) = arr(sd(y)(y1), n)
            Next
            k = k + 1
        Next
    Next
    ActiveSheet.Copy Before:=Sheets(1)
    With Sheets(1)
        .Range(Cells(9, 1), Cells(9, lc)).ClearContents
        .Range(Cells(10, 1), Cells(lr, lc)).Clear
        .Range(Cells(9, 1), Cells(9, lc)).Copy
        .Range("A9").Resize(UBound(arr_rez), UBound(arr_rez, 2)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .Range("A9").Resize(UBound(arr_rez), UBound(arr_rez, 2)) = arr_rez
    End With
End Sub
 
Перейти    
Копирование строки ниже, если в ячейке есть определённый текст
 
#
09.06.2025 13:19:21
А что делать с пустыми, удалять?
Изменено: Msi2102 - 09.06.2025 13:20:11
 
Перейти    
Условия для данных
 
#
06.06.2025 17:05:41
так?
=ЕСЛИ(A3>0;1;"")
сразу тема: Если в соседней ячейке значение больше 0:00:00, то установить 1, иначе пусто
Изменено: Msi2102 - 06.06.2025 17:17:24
 
Перейти    
Поиск значений по частичному совпадению
 
#
06.06.2025 17:01:55
Цитата
sotnikov написал:
=ЕСНД(ВПР(ПСТР(C9;9;9);'данные по принтам'!$A$2:$B$354;2;0);"")
Тогда лучше так
=ЕСНД(ВПР(ПСТР(C9;ПОИСК("-";C9)+1;999);'данные по принтам'!$A$2:$B$354;2;0);"")
 
Перейти    
Поиск значений по частичному совпадению
 
#
06.06.2025 16:08:36
Отсортируйте вторую таблицу по старту продаж от старых к новым
=ВПР(ПРАВСИМВ(C9;ДЛСТР(C9)-ПОИСК("-";C9));'данные по принтам'!$A$2:$B$354;2;0)
тема: Поиск значений по частичному совпадению
Изменено: Msi2102 - 06.06.2025 16:31:35
 
Перейти    
EXCEL формула порядковые номера по критерию, EXCEL формула порядковые номера по критерию
 
#
06.06.2025 14:01:55
Damir2206, добрый день! Файл с примером в формате Excel приложите
Изменено: Msi2102 - 06.06.2025 14:02:17
 
Перейти    
Выгрузка текстового файла в Excel, Проблемы из-за размера файла
 
#
06.06.2025 12:05:43
Цитата
Anisa написал:
Файл на 2 миллиона строк,
Может ПОЭТОМУ
Грузите в PQ и сохраняйте как подключение
Изменено: Msi2102 - 06.06.2025 12:08:12
 
Перейти    
Почему ВПР не видит мои данные
 
#
03.06.2025 16:26:14
А пробелы в конце не считаются? И на диапазон в формуле обратите внимание, возможно не хватает $
Изменено: Msi2102 - 03.06.2025 16:34:48
 
Перейти    
Умный фильтр ячеек в Excel, Фильтр в Excel всех ячеек с одним или с несколькими значениями только по одному условию
 
#
03.06.2025 15:46:53
Цитата
Сергей Ребров написал:
в ячейке появляется "#ИМЯ?".
Нужно более новую версию Excel, для старых версий не помню какие формулы, может кто-нибудь напишет UDF
Изменено: Msi2102 - 03.06.2025 15:52:04
 
Перейти    
Поиск изменённых позиций
 
#
03.06.2025 15:34:04
Цитата
TheJha написал:
Буду благодарен, если вы покажете реализованный результат мне в виде примера.
Ваш же пример, только отсортировано по Сделка.Код. В условном форматировании у Вас уже прописана формула, в столбце C и D (в D немного подправил), по аналогии пишите в остальные столбцы
 
Перейти    
Умный фильтр ячеек в Excel, Фильтр в Excel всех ячеек с одним или с несколькими значениями только по одному условию
 
#
03.06.2025 15:26:30
Цитата
Сергей Ребров написал:
Короче, в фильтре не хотелось бы ставить вручную галочку на всех вариантах, где есть золото, а выбрав только "золото", получать все строки, где есть в одной ячейке это название или это название и другие.
В фильтре в поле Поиск пишите "золото" и выделятся все строки где присутствует слово "золото". Как объединять ячейки через запятую, показал в сообщении #6
Изменено: Msi2102 - 03.06.2025 15:27:39
 
Перейти    
Поиск изменённых позиций
 
#
03.06.2025 15:19:41
Попробуйте отсортировать по столбцу Сделка.Код
 
Перейти    
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 137 След.
Наверх