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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 44 След.
Замена букв слова в одной ячейке на другие символы, Замена букв слова в одной ячейке на другие символы
 
Цитата
БМВ написал:
В случае с неполедовательной кодировкой и повторорами, наверно и правда иметь второй массив проще и брать из него значения
А где один массив, там и второй. Макрос из 16 сообщения более наглядный и проще для понимания  :)  
Замена букв слова в одной ячейке на другие символы, Замена букв слова в одной ячейке на другие символы
 
Цитата
БМВ написал:
да,это верно, но то что в текущем коде, реализуется проще
Я знаю, лень было писать, искать уже написанное. Взял, что первое подвернулось под руку  :D  
Отображение группированных столбцов при наличии в них скрытых, Скрытый столбец становится виден
 
Костыль
Код
Columns("D:D").ColumnWidth = 0.1


Изменено: Msi2102 - 22.10.2021 15:37:55
ВПР находит только часть значения
 
Цитата
Zagadka написал:
В общем, в основном файле так и не заработал ВПР, хотя диапазон там проверен, на всю таблицу.

Проверьте на ленте: вкладка ФОРМУЛЫ --> Параметры вычислений --> Автоматически
Замена букв слова в одной ячейке на другие символы, Замена букв слова в одной ячейке на другие символы
 
БМВ, Так проблем нет. Алфавит, я понял, будет весь, а числа пусть заменит на нужные, там вроде не сложно
Изменено: Msi2102 - 22.10.2021 14:46:44
[ Закрыто] Динамическая вставка фото и суммирование по условию
 
Цитата
Mershik написал:
выберите одну и для второй создайте тему и помогут
Или в платный раздел
Замена букв слова в одной ячейке на другие символы, Замена букв слова в одной ячейке на другие символы
 
Ещё можно ОТСЮДА подредактировать макрос
Код
Function Translit(Txt As String) As String
    Dim Rus As Variant
    Rus = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", _
    "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", _
    "щ", "ъ", "ы", "ь", "э", "ю", "я")
    Dim Eng As Variant
    Eng = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, _
    12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, _
    26, 27, 28, 29, 30, 31, 32, 33)
    For I = 1 To Len(Txt)
        с = Mid(LCase(Txt), I, 1)
        flag = 0
        For J = 0 To 32
            If Rus(J) = с Then
                outchr = Eng(J)
                flag = 1
                Exit For
            End If
        Next J
        If flag Then outstr = outstr & outchr Else outstr = outstr & с
    Next I
    Translit = outstr
End Function

А так сразу сумма

Код
Function Translit_S(Txt As String) 
    Dim Rus As Variant
    Rus = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", _
    "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", _
    "щ", "ъ", "ы", "ь", "э", "ю", "я")
    Dim Eng As Variant
    Eng = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, _
    12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, _
    26, 27, 28, 29, 30, 31, 32, 33)
    For I = 1 To Len(Txt)
        с = Mid(LCase(Txt), I, 1)
        flag = 0
        For J = 0 To 32
            If Rus(J) = с Then
                outchr = Eng(J)
                flag = 1
                Exit For
            End If
        Next J
        If flag Then outstr = outstr + outchr Else outstr = outstr
    Next I
    Translit_S = outstr
End Function
Изменено: Msi2102 - 22.10.2021 14:13:03
Группировка данных по нескольким полям
 
Так?
Сводная таблица по заказам с разных листов
 
Power Query
Код
let
    fn=(x)=>Excel.CurrentWorkbook(){[Name=x]}[Content],
    a = fn("Таблица1"),
    b = fn("Таблица3"),
    c = fn("Таблица4"),
    e = Table.Combine({a, b, c}),
    to = Table.SelectRows(e, each ([Заказ] <> null))
in
    to
Замена букв слова в одной ячейке на другие символы, Замена букв слова в одной ячейке на другие символы
 
Может ЭТО ищете?
Как из одной ячейки исключить слова находящиеся в других ячейках
 
Цитата
Lerik2020 написал:
"=ЕСЛИ(C6="";"";C6&СИМВОЛ(10))""
А с какой целью Вы добавляете перенос строки в конец?
Если хотите, чтобы у Вас каждое слово было через перенос строки, то напишите так:
Код
=СцепитьМного(B13:K13;"; "&СИМВОЛ(10);1;O13:X13)
Изменено: Msi2102 - 22.10.2021 12:13:32
Как из одной ячейки исключить слова находящиеся в других ячейках
 
Можно немного дописать, примерно так:
Код
Function СцепитьМного(Диапазон As Range, Optional Разделитель As String = " ", Optional БезПовторов As Boolean = False, Optional Исключение As Range)
    Dim avData, isData, lr As Long, lc As Long, sRes As String
    avData = Диапазон.Value
    If Not IsArray(avData) Then
        СцепитьМного = avData
        Exit Function
    End If
 
    For lc = 1 To UBound(avData, 2)
        For lr = 1 To UBound(avData, 1)
            If Len(avData(lr, lc)) Then
                sRes = sRes & Разделитель & avData(lr, lc)
            End If
        Next lr
    Next lc
    If Len(sRes) Then
        sRes = Mid(sRes, Len(Разделитель) + 1)
    End If
    
        Dim oDict As Object, sTmpStr
        Set oDict = CreateObject("Scripting.Dictionary")

    If БезПовторов Then
        sTmpStr = Split(sRes, Разделитель)
        On Error Resume Next
        For lr = LBound(sTmpStr) To UBound(sTmpStr)
            oDict.Add sTmpStr(lr), sTmpStr(lr)
        Next lr
        sRes = ""
        sTmpStr = oDict.keys
        For lr = LBound(sTmpStr) To UBound(sTmpStr)
            sRes = sRes & IIf(sRes <> "", Разделитель, "") & sTmpStr(lr)
        Next lr
    End If
    
    If Not Исключение Is Nothing Then
        isData = Исключение.Value
        sTmpStr = Split(sRes, Разделитель)
        oDict.RemoveAll
        For lc = 1 To UBound(isData, 2)
            For lr = 1 To UBound(isData, 1)
                If Len(isData(lr, lc)) Then
                    If Not oDict.Exists(isData(lr, lc)) Then oDict.Add isData(lr, lc), isData(lr, lc)
                End If
            Next lr
        Next lc
        sRes = ""
        For lr = LBound(sTmpStr) To UBound(sTmpStr)
            If Not oDict.Exists(sTmpStr(lr)) Then sRes = sRes & IIf(sRes <> "", Разделитель, "") & sTmpStr(lr)
        Next lr

    End If
    
    СцепитьМного = sRes
End Function
Изменено: Msi2102 - 22.10.2021 09:16:47
Поиск в диапазоне из другого диапазона и подстановка значения
 
Здравствуйте
Посмотрите ЗДЕСЬ у Дмитрия Щербакова
Автоматизированное заполнение карточек учета материалов М-17, Необходимо заполнить около 1000 карточек учета материалов
 
А для чего вообще сохранять карточки, достаточно просто заполнять шаблон по необходимости, а все данные хранятся в таблице
Автоматизированное заполнение карточек учета материалов М-17, Необходимо заполнить около 1000 карточек учета материалов
 
Andrey, здравствуйте.
У Вас будет тысяча и один лист в книге?
Задать условие выдачи минимальной цены только при наличии трех конкурентов
 
Семен Фадеев, у Вас 30 сообщений, а ПРАВИЛА так и не читали, приложите файл с примером
Суммирование по условиям, в том числе по цвету
 
Цитата
alex ku написал:
СПАСЛИ
Ну уж если совсем проблема была, могли обойтись Вашей функцией из первого поста
Код
=СЧЁТЕСЛИМН_ЦВЕТ(F14:F25;G14:G25;"яблоки";H14:H25;"поставили";I14)+СЧЁТЕСЛИМН_ЦВЕТ(F14:F25;G14:G25;"яблоки";H14:H25;"оплатили";I14)+СЧЁТЕСЛИМН_ЦВЕТ(F14:F25;G14:G25;"груши";H14:H25;"поставили";I14)+СЧЁТЕСЛИМН_ЦВЕТ(F14:F25;G14:G25;"груши";H14:H25;"оплатили";I14)
Создание накладной из пакинг листа, совмещение названий строк, столбцов и значений
 
Power Query
Код
let
    Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    #"Другие столбцы с отмененным свертыванием" = Table.UnpivotOtherColumns(Источник, {"Столбец1"}, "Атрибут", "Значение"),
    #"Объединенные столбцы" = Table.CombineColumns(Table.TransformColumnTypes(#"Другие столбцы с отмененным свертыванием", {{"Столбец1", type text}}, "ru-RU"),{"Столбец1", "Атрибут"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Сведено")
in
    #"Объединенные столбцы"
Изменено: Msi2102 - 14.10.2021 15:11:52
Суммирование по условиям, в том числе по цвету
 
Все равно не до конца понял, что Вы хотите, попробуйте так:
Код
Function СЧЁТЕСЛИМН_ЦВЕТ(диапазон_сумм As Range, _
                        диапазон_усл1 As Range, усл1 As Variant, _
                        диапазон_усл2 As Range, усл2 As Variant, _
                        образец_цв As Range)
Application.Calculation = xlCalculationAutomatic
Application.Volatile True
usl_1 = Split(усл1, ",")
usl_2 = Split(усл2, ",")
Sum = 0
For n = LBound(usl_1) To UBound(usl_1)
    For m = LBound(usl_2) To UBound(usl_2)
        For Each cl In диапазон_сумм
            If Trim(Cells(cl.Row, диапазон_усл1.Column)) = Trim(usl_1(n)) And _
                Trim(Cells(cl.Row, диапазон_усл2.Column)) = Trim(usl_2(m)) And _
                cl.Interior.ColorIndex = образец_цв.Interior.ColorIndex And _
                cl.Interior.Pattern = образец_цв.Interior.Pattern Then Sum = Sum + 1
        Next
    Next
Next
СЧЁТЕСЛИМН_ЦВЕТ = Sum
End Function
условия записывайте, через запятую
Код
=СЧЁТЕСЛИМН_ЦВЕТ(F14:F25;G14:G25;"яблоки,груши";H14:H25;"поставили,оплатили";I14)
Суммирование по условиям, в том числе по цвету
 
Цитата
alex ku написал:
при выполнении всех трех условий
Так в первом Вашем сообщении функция так и считает.
От того, что во второй таблице Вы покрасили ячейки, яблоки не становятся грушами
Изменено: Msi2102 - 14.10.2021 13:38:16
Как получить из 2-х пересекающихся диапазонов непересекающиеся части?, Есть ли в VBA функция, обратная Intersect
 
Можно так
Код
Sub dfdfdf()
Dim x As Range, y As Range, Rng As Range
Set x = Range("B3:D6")
Set y = Range("C5:F7")
    For Each r In Application.Union(x, y)
        If Application.Intersect(r, Application.Intersect(x, y)) Is Nothing Then
            If Rng Is Nothing Then Set Rng = r Else Set Rng = Union(Rng, r)
        End If
    Next r
Rng.Select
MsgBox Rng.Address
End Sub
Суммирование по условиям, в том числе по цвету
 
Почему должно быть 4? Проверьте ещё раз свои условия
Может вы имели ввиду: если ячейка, с образцом цвета, закрашена, то считать по закрашенные ячейки этим цветом, иначе считать по другим условиям. Тогда попробуйте так:
Код
Function СЧЁТЕСЛИМН_ЦВЕТ(диапазон_сумм As Range, диапазон_усл1 As Range, усл1 As Variant, диапазон_усл2 As Range, усл2 As Variant, образец_цв As Range)
Application.Calculation = xlCalculationAutomatic
Application.Volatile True
Sum = 0
For Each cl In диапазон_сумм
    If образец_цв.Interior.ColorIndex <> -4142 Then
        If cl.Interior.ColorIndex = образец_цв.Interior.ColorIndex Then Sum = Sum + 1
    ElseIf Cells(cl.Row, диапазон_усл1.Column) = усл1 And Cells(cl.Row, диапазон_усл2.Column) = усл2 Then
        Sum = Sum + 1
    End If
Next
СЧЁТЕСЛИМН_ЦВЕТ = Sum
End Function
Изменено: Msi2102 - 14.10.2021 12:38:52
Разделение данных ячейки на строки.
 
Power Query
Код
let
    Источник = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Измененный тип" = Table.TransformColumnTypes(Источник,{{"First Name", type text}, {"Last Name", type text}, {"Date of birth", type date}, {"Phone", type text}, {"Department", Int64.Type}, {"Rank", Int64.Type}}),
    #"Разделить столбец по разделителю" = Table.ExpandListColumn(Table.TransformColumns(#"Измененный тип", {{"Phone", Splitter.SplitTextByDelimiter(", ", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Phone")
in
    #"Разделить столбец по разделителю"
Изменено: Msi2102 - 14.10.2021 07:32:00
PQ Собрать данные из разных листов книги
 
Цитата
Prosvetov написал:
Найти решение на форуме не удалось.
ЗДЕСЬ смотрели
Распределение сотрудников по рабочим местам, Есть желание написать программку, способную распределять сотрудников по рабочим станциях
 
Она наверное не знает, где находится личка 😄.
Я еë в эту ветку за руку вел
Перенос строк/удаление строк после переноса
 
Если бы Вы пытались переделать мой код, то он бы выглядел вот так:
Код
Sub Удаление_строк_1()
Dim a As Long, ShNN_1 As ListObject, ShON_1 As ListObject
    Set ShNN_1 = Worksheets("Новые сотрудники").ListObjects("Новые_сотрудники_tb")
    Set ShON_1 = Worksheets("Списки сотрудников").ListObjects("Списки_сотрудников_tb")
    ShON_1.ListRows.Add AlwaysInsert:=True
    a = ShON_1.ListRows.Count
    ShNN_1.DataBodyRange.Copy ShON_1.ListRows(a).Range
    Application.CutCopyMode = False
    Selection.ListObject.DataBodyRange.Delete
End Sub

А Вы скорее пытаетесь написать свой, что собственно похвально.

VBA Excel. Метод Range.Insert (вставка со сдвигом ячеек), почитайте здесь про этот метод, он позволяет Вам вставить ячейки со сдвигом имеющихся ячеек.
Этой строкой:
Код
Set ONListRow = ONListObj.ListRows.Add
добавили строку в конец таблицы
Этой:
Код
Paste = ONListObj.ListRows.Count
посчитали количество строк
А этой:
Код
ONListRow = ShON.ListObjects("Списки_сотрудников_tb").ListRows(Paste).Range.Insert
вставляете скопированные строки перед вставленной строкой (т.к. она последняя и её номер соответствует количеству строк в переменной "Paste"), сдвигая её вниз.
Чтобы понятнее было, в коде закомментируйте строку добавления строки и замените переменную "Paste" на 1, тогда список будет вставляться в начало таблицы, сдвигая все данные вниз.
Код
ONListRow = ShON.ListObjects("Списки_сотрудников_tb").ListRows(1).Range.Insert

Поэтому для того, чтобы не было пустой строки напишите так:
Код
ShNN.ListObjects("Новые_сотрудники_tb").DataBodyRange.Copy ShON.ListObjects("Списки_сотрудников_tb").ListRows(Paste).Range

При этом строки:
Код
Copy = ShNN.ListObjects("Новые_сотрудники_tb").DataBodyRange.Copy
и
Код
ONListRow = ShON.ListObjects("Списки_сотрудников_tb").ListRows(Paste).Range.Insert
удалите или закомментируйте

Я не знаю, где ещё в коде Вы используете эти переменные NNListRow и NNListObj, но в этой процедуре они не используются, поэтому если код только на копирование строк, то их можно удалить.
Изменено: Msi2102 - 07.10.2021 09:07:46
Перенос строк/удаление строк после переноса
 
В фале примере есть два списка, первый "Список сотрудников" второй "Новые сотрудники". Вам нужно весь первый список вставить в конец второго после чего первый список очищаем? Если так, то я не понимаю в чем проблема. нужно просто выделить все данные (Ctrl+a) вырезать (Ctrl+x) и вставить в нужное место (Ctrl+v) (или мышкой правой кнопкой по нужным менюшка) работа в три действия. Собственно проблем написать макрос нет, просто нужно конкретно знать ваши задачи.
Посмотрите файл. Так?
Тоже двойным щелчком
Изменено: Msi2102 - 06.10.2021 14:54:57
Перенос строк/удаление строк после переноса
 
Я не понимаю, что именно Вы хотите. Скопировать весь список, выделенные позиции или может помеченные?
Распределение сотрудников по рабочим местам, Есть желание написать программку, способную распределять сотрудников по рабочим станциях
 
Модераторы перенесут, а находится эта ветка тут:
Изменено: Msi2102 - 06.10.2021 14:02:25
Распределение сотрудников по рабочим местам, Есть желание написать программку, способную распределять сотрудников по рабочим станциях
 
Я думаю с таким ТЗ Вам в платную ветку
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 44 След.
Наверх